NMF/0000755000176000001440000000000012531007322010715 5ustar ripleyusersNMF/TODO0000644000176000001440000000133012234465004011407 0ustar ripleyusersFeatures: o handle missing data in target matrix o NMF model/algorithm class for MCMC based NMF o function/option to run standard consensus clustering, i.e. with a different set sample for each run. Possibly also use subsets of features and consensus matrix for them (memory issue). o incorporate silhouette values/plots, notably in heatmaps o support for other type of matrix-like objects (e.g., bigmatrix, Matrix) o import/export functions Documentation: o improve/update vignettes Technical/Internals: o change plot.NMFrankestimate to screeplot, remove class NMFrankestimate, change it to normal NMFlist o Switch to the interface defined in the package modeltools NMF/inst/0000755000176000001440000000000012234465004011677 5ustar ripleyusersNMF/inst/CITATION0000644000176000001440000000323712234465004013041 0ustar ripleyusers## R >= 2.8.0 passes package metadata to citation(). if( !exists('meta') || is.null(meta) ) meta <- packageDescription("NMF") year <- sub(".*(2[[:digit:]]{3})-.*", "\\1", meta$Date, perl = TRUE) vers <- paste("R package version", meta$Version) author <- as.personList(meta$Author) url <- sprintf("http://cran.r-project.org/package=%s", meta$Package) citHeader(sprintf("To cite the package '%s' in publications use:", meta$Package)) citEntry(entry="Article" , title = "A flexible R package for nonnegative matrix factorization" , author = personList(as.person("Renaud Gaujoux"), as.person("Cathal Seoighe")) , journal = "BMC Bioinformatics" , year = 2010 , volume = 11 , number = 1 , pages = 367 , url = "http://www.biomedcentral.com/1471-2105/11/367" , doi = "10.1186/1471-2105-11-367" , issn = "1471-2105" , textVersion = paste("Renaud Gaujoux, Cathal Seoighe (2010)" , "A flexible R package for nonnegative matrix factorization" , "BMC Bioinformatics 2010, 11:367" , "[http://www.biomedcentral.com/1471-2105/11/367]" , sep=". ") ) citEntry(entry="Manual" , title = vign <- "Using the package NMF" , author = author , publisher = "CRAN" , year = year , note = vers , url = url , textVersion = sprintf("%s (%s). %s. CRAN. %s. [%s]", author, year, vign, vers, url) , header = "Vignette(s):" ) citEntry(entry="Manual" , title = "The package NMF: manual pages" , author = author , publisher = "CRAN" , year = year , note = vers , url = url , textVersion = sprintf("%s (%s). %s CRAN. %s. [%s]", author, year, meta$Title, vers, url) , header = "Technical documentation:" ) NMF/inst/REFERENCES.bib0000644000176000001440000010516612234465004014007 0ustar ripleyusers@Manual{R, address = {Vienna, Austria}, annote = {\{ISBN\} 3-900051-07-0}, author = {{R Development Core Team}}, organization = {R Foundation for Statistical Computing}, title = {{R: A Language and Environment for Statistical Computing}}, url = {http://www.r-project.org}, year = {2011}, } @Article{Gentleman2004, abstract = {The Bioconductor project is an initiative for the collaborative creation of extensible software for computational biology and bioinformatics. The goals of the project include: fostering collaborative development and widespread use of innovative software, reducing barriers to entry into interdisciplinary scientific research, and promoting the achievement of remote reproducibility of research results. We describe details of our aims and methods, identify current challenges, compare Bioconductor to other open bioinformatics projects, and provide working examples.}, author = {Robert C Gentleman and Vincent J Carey and Douglas M Bates and Ben Bolstad and Marcel Dettling and Sandrine Dudoit and Byron Ellis and Laurent Gautier and Yongchao Ge and Jeff Gentry and Kurt Hornik and Torsten Hothorn and Wolfgang Huber and Stefano Iacus and Rafael Irizarry and Friedrich Leisch and Cheng Li and Martin Maechler and Anthony J Rossini and Gunther Sawitzki and Colin Smith and Gordon Smyth and Luke Tierney and Jean Y H Yang and Jianhua Zhang}, doi = {10.1186/gb-2004-5-10-r80}, issn = {1465-6914}, journal = {Genome biology}, keywords = {Computational Biology,Computational Biology: instrumentation,Computational Biology: methods,Internet,Reproducibility of Results,Software}, number = {10}, pages = {R80}, pmid = {15461798}, shorttitle = {Genome Biol}, title = {{Bioconductor: open software development for computational biology and bioinformatics.}}, url = {http://www.ncbi.nlm.nih.gov/pubmed/15461798}, volume = {5}, year = {2004}, } @Article{Lee2001, author = {D D Lee and HS Seung}, file = {:home/renaud/Documents/articles/NMF/Algorithms for non-negative matrix factorization\_Lee2000.pdf:pdf}, journal = {Advances in neural information processing systems}, title = {{Algorithms for non-negative matrix factorization}}, url = {http://scholar.google.com/scholar?q=intitle:Algorithms+for+non-negative+matrix+factorization\#0}, year = {2001}, } @Article{Li2001, author = {Stan Z Li and Xinwen Hou}, file = {:home/renaud/Documents/articles/NMF/Learning Spatially Localized, Parts-Based Representation\_Li2001.pdf:pdf}, journal = {Convergence}, number = {C}, pages = {1--6}, title = {{Learning Spatially Localized, Parts-Based Representation}}, volume = {00}, year = {2001}, } @Article{Badea2008, abstract = {In this paper we introduce a clustering algorithm capable of simultaneously factorizing two distinct gene expression datasets with the aim of uncovering gene regulatory programs that are common to the two phenotypes. The siNMF algorithm simultaneously searches for two factorizations that share the same gene expression profiles. The two key ingredients of this algorithm are the nonnegativity constraint and the offset variables, which together ensure the sparseness of the factorizations. While cancer is a very heterogeneous disease, there is overwhelming recent evidence that the differences between cancer subtypes implicate entire pathways and biological processes involving large numbers of genes, rather than changes in single genes. We have applied our simultaneous factorization algorithm looking for gene expression profiles that are common between the more homogeneous pancreatic ductal adenocarcinoma (PDAC) and the more heterogeneous colon adenocarcinoma. The fact that the PDAC signature is active in a large fraction of colon adeocarcinoma suggests that the oncogenic mechanisms involved may be similar to those in PDAC, at least in this subset of colon samples. There are many approaches to uncovering common mechanisms involved in different phenotypes, but most are based on comparing gene lists. The approach presented in this paper additionally takes gene expression data into account and can thus be more sensitive.}, author = {Liviu Badea}, file = {:home/renaud/Documents/articles/NMF/Extracting Gene Expression Profiles Common to Colon and Pancreatic Adenocarcinoma Using Simultaneous Nonnegative Matrix Factorization\_Badea2008.pdf:pdf}, issn = {1793-5091}, journal = {Pacific Symposium on Biocomputing. Pacific Symposium on Biocomputing}, keywords = {Adenocarcinoma,Adenocarcinoma: genetics,Algorithms,Carcinoma,Colonic Neoplasms,Colonic Neoplasms: genetics,Computational Biology,Data Interpretation,Databases,Gene Expression Profiling,Gene Expression Profiling: statistics \& numerical,Genetic,Humans,Pancreatic Ductal,Pancreatic Ductal: genetics,Pancreatic Neoplasms,Pancreatic Neoplasms: genetics,Statistical}, month = {jan}, pages = {267--78}, pmid = {18229692}, title = {{Extracting gene expression profiles common to colon and pancreatic adenocarcinoma using simultaneous nonnegative matrix factorization.}}, url = {http://www.ncbi.nlm.nih.gov/pubmed/18229692}, volume = {290}, year = {2008}, } @Article{Zhang2008, abstract = {Independent component analysis (ICA) is a widely applicable and effective approach in blind source separation (BSS), with limitations that sources are statistically independent. However, more common situation is blind source separation for nonnegative linear model (NNLM) where the observations are nonnegative linear combinations of nonnegative sources, and the sources may be statistically dependent. We propose a pattern expression nonnegative matrix factorization (PE-NMF) approach from the view point of using basis vectors most effectively to express patterns. Two regularization or penalty terms are introduced to be added to the original loss function of a standard nonnegative matrix factorization (NMF) for effective expression of patterns with basis vectors in the PE-NMF. Learning algorithm is presented, and the convergence of the algorithm is proved theoretically. Three illustrative examples on blind source separation including heterogeneity correction for gene microarray data indicate that the sources can be successfully recovered with the proposed PE-NMF when the two parameters can be suitably chosen from prior knowledge of the problem.}, author = {Junying Zhang and Le Wei and Xuerong Feng and Zhen Ma and Yue Wang}, doi = {10.1155/2008/168769}, file = {:home/renaud/Documents/articles/NMF/Pattern Expression Nonnegative Matrix Factorization$\backslash$: Algorithm and Applications to Blind Source Separation\_Zhang2008.pdf:pdf}, issn = {1687-5265}, journal = {Computational intelligence and neuroscience}, pages = {168769}, pmid = {18566689}, shorttitle = {Comput Intell Neurosci}, title = {{Pattern expression nonnegative matrix factorization: algorithm and applications to blind source separation.}}, url = {http://www.ncbi.nlm.nih.gov/pubmed/18566689}, volume = {2008}, year = {2008}, } @Article{KimH2007, abstract = {MOTIVATION: Many practical pattern recognition problems require non-negativity constraints. For example, pixels in digital images and chemical concentrations in bioinformatics are non-negative. Sparse non-negative matrix factorizations (NMFs) are useful when the degree of sparseness in the non-negative basis matrix or the non-negative coefficient matrix in an NMF needs to be controlled in approximating high-dimensional data in a lower dimensional space. RESULTS: In this article, we introduce a novel formulation of sparse NMF and show how the new formulation leads to a convergent sparse NMF algorithm via alternating non-negativity-constrained least squares. We apply our sparse NMF algorithm to cancer-class discovery and gene expression data analysis and offer biological analysis of the results obtained. Our experimental results illustrate that the proposed sparse NMF algorithm often achieves better clustering performance with shorter computing time compared to other existing NMF algorithms. AVAILABILITY: The software is available as supplementary material.}, author = {Hyunsoo Kim and Haesun Park}, doi = {10.1093/bioinformatics/btm134}, file = {:home/renaud/Documents/articles/NMF/Sparse non-negative matrix factorizations via alternating non-negativity-constrained least squares for microarray data analysis Kim2007.pdf:pdf}, issn = {1460-2059}, journal = {Bioinformatics (Oxford, England)}, keywords = {Algorithms,Automated,Automated: methods,Cluster Analysis,Computational Biology,Computational Biology: methods,Data Interpretation,Databases,Entropy,Factor Analysis,Gene Expression,Genetic,Humans,Least-Squares Analysis,Microarray Analysis,Neoplasms,Neoplasms: classification,Neoplasms: genetics,Neoplasms: metabolism,Pattern Recognition,Statistical}, number = {12}, pages = {1495--502}, pmid = {17483501}, shorttitle = {Bioinformatics}, title = {{Sparse non-negative matrix factorizations via alternating non-negativity-constrained least squares for microarray data analysis.}}, url = {http://www.ncbi.nlm.nih.gov/pubmed/17483501}, volume = {23}, year = {2007}, } @TechReport{Albright2006, author = {Russell Albright and James Cox and David Duling and Amy N. Langville and C. Meyer}, booktitle = {Matrix}, file = {:home/renaud/Documents/articles/NMF/Algorithms, Initializations, and Convergence for the Nonnegative Matrix Factorization\_Langville2006.pdf:pdf}, institution = {NCSU Technical Report Math 81706. http://meyer. math. ncsu. edu/Meyer/Abstracts/Publications. html}, keywords = {60j22,65b99,65c40,65f10,65f15,65f50,alternating least squares,ams subject classi cations,clustering,convergence crite-,image processing,initializations,nonnegative matrix factorization,rion,text mining}, number = {919}, title = {{Algorithms, initializations, and convergence for the nonnegative matrix factorization}}, url = {http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.89.2161\&rep=rep1\&type=pdf http://meyer.math.ncsu.edu/Meyer/PS\_Files/NMFInitAlgConv.pdf}, year = {2006}, } @Article{Boutsidis2008, author = {C Boutsidis and E Gallopoulos}, doi = {10.1016/j.patcog.2007.09.010}, file = {:home/renaud/Documents/articles/NMF/SVD based initialization$\backslash$: A head start for nonnegative matrix factorization\_Boutsidis2008.pdf:pdf}, issn = {00313203}, journal = {Pattern Recognition}, month = {apr}, number = {4}, pages = {1350--1362}, title = {{SVD based initialization: A head start for nonnegative matrix factorization}}, url = {http://linkinghub.elsevier.com/retrieve/pii/S0031320307004359}, volume = {41}, year = {2008}, } @Article{Lecuyer2002, author = {Pierre L'Ecuyer and Richard Simard and E.J. Chen}, file = {:home/renaud/Documents/articles/stats/An Object-Oriented Random-Number Package with Many Long Streams and Substreams\_Lecuyer2002.pdf:pdf}, journal = {Operations Research}, number = {6}, pages = {1073--1075}, publisher = {JSTOR}, title = {{An object-oriented random-number package with many long streams and substreams}}, url = {http://www.jstor.org/stable/3088626}, volume = {50}, year = {2002}, } @Article{Hutchins2008, abstract = {MOTIVATION: Cis-acting regulatory elements are frequently constrained by both sequence content and positioning relative to a functional site, such as a splice or polyadenylation site. We describe an approach to regulatory motif analysis based on non-negative matrix factorization (NMF). Whereas existing pattern recognition algorithms commonly focus primarily on sequence content, our method simultaneously characterizes both positioning and sequence content of putative motifs. RESULTS: Tests on artificially generated sequences show that NMF can faithfully reproduce both positioning and content of test motifs. We show how the variation of the residual sum of squares can be used to give a robust estimate of the number of motifs or patterns in a sequence set. Our analysis distinguishes multiple motifs with significant overlap in sequence content and/or positioning. Finally, we demonstrate the use of the NMF approach through characterization of biologically interesting datasets. Specifically, an analysis of mRNA 3'-processing (cleavage and polyadenylation) sites from a broad range of higher eukaryotes reveals a conserved core pattern of three elements.}, author = {Lucie N Hutchins and Sean M Murphy and Priyam Singh and Joel H Graber}, doi = {10.1093/bioinformatics/btn526}, file = {:home/renaud/Documents/articles/NMF/Position-dependent motif characterization using non-negative matrix factorization\_Hutchins2008.pdf:pdf}, issn = {1367-4811}, journal = {Bioinformatics (Oxford, England)}, keywords = {Algorithms,Computational Biology,Computational Biology: methods,Messenger,Messenger: genetics,Messenger: metabolism,RNA,Regulatory Sequences,Ribonucleic Acid,Sequence Analysis}, month = {dec}, number = {23}, pages = {2684--90}, pmid = {18852176}, title = {{Position-dependent motif characterization using non-negative matrix factorization.}}, url = {http://www.ncbi.nlm.nih.gov/pubmed/18852176}, volume = {24}, year = {2008}, } @Article{Frigyesi2008, abstract = {Non-negative matrix factorization (NMF) is a relatively new approach to analyze gene expression data that models data by additive combinations of non-negative basis vectors (metagenes). The non-negativity constraint makes sense biologically as genes may either be expressed or not, but never show negative expression. We applied NMF to five different microarray data sets. We estimated the appropriate number metagens by comparing the residual error of NMF reconstruction of data to that of NMF reconstruction of permutated data, thus finding when a given solution contained more information than noise. This analysis also revealed that NMF could not factorize one of the data sets in a meaningful way. We used GO categories and pre defined gene sets to evaluate the biological significance of the obtained metagenes. By analyses of metagenes specific for the same GO-categories we could show that individual metagenes activated different aspects of the same biological processes. Several of the obtained metagenes correlated with tumor subtypes and tumors with characteristic chromosomal translocations, indicating that metagenes may correspond to specific disease entities. Hence, NMF extracts biological relevant structures of microarray expression data and may thus contribute to a deeper understanding of tumor behavior.}, author = {Attila Frigyesi and Mattias H\"{o}glund}, file = {:home/renaud/Documents/articles/NMF/Non-Negative Matrix Factorization for the Analysis of Complex Gene Expression Data$\backslash$: Identification of Clinically Relevant Tumor Subtypes\_Frigyesi2008.pdf:pdf}, issn = {1176-9351}, journal = {Cancer informatics}, keywords = {gene expression,metagenes,nmf,tumor classifi cation}, month = {jan}, number = {2003}, pages = {275--92}, pmid = {19259414}, title = {{Non-negative matrix factorization for the analysis of complex gene expression data: identification of clinically relevant tumor subtypes.}}, url = {http://www.ncbi.nlm.nih.gov/pmc/articles/PMC2623306/}, volume = {6}, year = {2008}, } @Article{Brunet2004, abstract = {We describe here the use of nonnegative matrix factorization (NMF), an algorithm based on decomposition by parts that can reduce the dimension of expression data from thousands of genes to a handful of metagenes. Coupled with a model selection mechanism, adapted to work for any stochastic clustering algorithm, NMF is an efficient method for identification of distinct molecular patterns and provides a powerful method for class discovery. We demonstrate the ability of NMF to recover meaningful biological information from cancer-related microarray data. NMF appears to have advantages over other methods such as hierarchical clustering or self-organizing maps. We found it less sensitive to a priori selection of genes or initial conditions and able to detect alternative or context-dependent patterns of gene expression in complex biological systems. This ability, similar to semantic polysemy in text, provides a general method for robust molecular pattern discovery.}, author = {Jean-Philippe Brunet and Pablo Tamayo and Todd R Golub and Jill P Mesirov}, doi = {10.1073/pnas.0308531101}, file = {:home/renaud/Documents/articles/NMF/Metagenes and Molecular pattern discovery using matrix factorization Brunet2004.pdf:pdf}, issn = {0027-8424}, journal = {Proceedings of the National Academy of Sciences of the United States of America}, keywords = {Algorithms,Central Nervous System Neoplasms,Central Nervous System Neoplasms: classification,Central Nervous System Neoplasms: genetics,Computational Biology,Data Interpretation,Genetic,Leukemia,Leukemia: classification,Leukemia: genetics,Medulloblastoma,Medulloblastoma: genetics,Models,Neoplasms,Neoplasms: classification,Neoplasms: genetics,Statistical}, number = {12}, pages = {4164--9}, pmid = {15016911}, title = {{Metagenes and molecular pattern discovery using matrix factorization.}}, url = {http://www.ncbi.nlm.nih.gov/pubmed/15016911}, volume = {101}, year = {2004}, } @Article{Pascual-Montano2006, author = {Alberto Pascual-Montano and Jose Maria Carazo and K Kochi and D Lehmann and R D Pascual-marqui}, file = {:home/renaud/Documents/articles/NMF/Nonsmooth nonnegative matrix factorization (nsNMF)\_Paascual-Montano2006.pdf:pdf}, journal = {IEEE Trans. Pattern Anal. Mach. Intell}, pages = {403--415}, title = {{Nonsmooth nonnegative matrix factorization (nsNMF)}}, volume = {28}, year = {2006}, } @Article{Lee1999, abstract = {Is perception of the whole based on perception of its parts? There is psychological and physiological evidence for parts-based representations in the brain, and certain computational theories of object recognition rely on such representations. But little is known about how brains or computers might learn the parts of objects. Here we demonstrate an algorithm for non-negative matrix factorization that is able to learn parts of faces and semantic features of text. This is in contrast to other methods, such as principal components analysis and vector quantization, that learn holistic, not parts-based, representations. Non-negative matrix factorization is distinguished from the other methods by its use of non-negativity constraints. These constraints lead to a parts-based representation because they allow only additive, not subtractive, combinations. When non-negative matrix factorization is implemented as a neural network, parts-based representations emerge by virtue of two properties: the firing rates of neurons are never negative and synaptic strengths do not change sign.}, author = {D D Lee and H S Seung}, doi = {10.1038/44565}, file = {:home/renaud/Documents/articles/NMF/Learning the parts of objects by non-negative matrix factorization\_Lee1999.pdf:pdf}, issn = {0028-0836}, journal = {Nature}, keywords = {Algorithms,Face,Humans,Learning,Models,Neurological,Perception,Perception: physiology,Semantics}, month = {oct}, number = {6755}, pages = {788--91}, pmid = {10548103}, title = {{Learning the parts of objects by non-negative matrix factorization.}}, url = {http://www.ncbi.nlm.nih.gov/pubmed/10548103}, volume = {401}, year = {1999}, } @Article{Paatero1994, abstract = {A new variant ?PMF? of factor analysis is described. It is assumed that X is a matrix of observed data and ? is the known matrix of standard deviations of elements of X. Both X and ? are of dimensions n × m. The method solves the bilinear matrix problem X = GF + E where G is the unknown left hand factor matrix (scores) of dimensions n × p, F is the unknown right hand factor matrix (loadings) of dimensions p × m, and E is the matrix of residuals. The problem is solved in the weighted least squares sense: G and F are determined so that the Frobenius norm of E divided (element-by-element) by ? is minimized. Furthermore, the solution is constrained so that all the elements of G and F are required to be non-negative. It is shown that the solutions by PMF are usually different from any solutions produced by the customary factor analysis (FA, i.e. principal component analysis (PCA) followed by rotations). Usually PMF produces a better fit to the data than FA. Also, the result of PF is guaranteed to be non-negative, while the result of FA often cannot be rotated so that all negative entries would be eliminated. Different possible application areas of the new method are briefly discussed. In environmental data, the error estimates of data can be widely varying and non-negativity is often an essential feature of the underlying models. Thus it is concluded that PMF is better suited than FA or PCA in many environmental applications. Examples of successful applications of PMF are shown in companion papers.}, author = {Pentti Paatero and Unto Tapper}, doi = {10.1002/env.3170050203}, journal = {Environmetrics}, keywords = {algorithm,nmf}, mendeley-tags = {algorithm,nmf}, number = {2}, pages = {111--126}, title = {{Positive matrix factorization: A non-negative factor model with optimal utilization of error estimates of data values}}, type = {Journal article}, url = {http://www3.interscience.wiley.com/cgi-bin/abstract/113468839/ABSTRACT}, volume = {5}, year = {1994}, } @Article{Hoyer2004, author = {PO Hoyer}, file = {:home/renaud/Documents/articles/NMF/Non-negative Matrix Factorization with Sparseness Constraints\_Hoyer2004.pdf:pdf}, journal = {The Journal of Machine Learning Research}, pages = {1457--1469}, title = {{Non-negative matrix factorization with sparseness constraints}}, url = {http://portal.acm.org/citation.cfm?id=1044709}, volume = {5}, year = {2004}, } @Article{Carmona-Saez2006, abstract = {BACKGROUND: The extended use of microarray technologies has enabled the generation and accumulation of gene expression datasets that contain expression levels of thousands of genes across tens or hundreds of different experimental conditions. One of the major challenges in the analysis of such datasets is to discover local structures composed by sets of genes that show coherent expression patterns across subsets of experimental conditions. These patterns may provide clues about the main biological processes associated to different physiological states. RESULTS: In this work we present a methodology able to cluster genes and conditions highly related in sub-portions of the data. Our approach is based on a new data mining technique, Non-smooth Non-Negative Matrix Factorization (nsNMF), able to identify localized patterns in large datasets. We assessed the potential of this methodology analyzing several synthetic datasets as well as two large and heterogeneous sets of gene expression profiles. In all cases the method was able to identify localized features related to sets of genes that show consistent expression patterns across subsets of experimental conditions. The uncovered structures showed a clear biological meaning in terms of relationships among functional annotations of genes and the phenotypes or physiological states of the associated conditions. CONCLUSION: The proposed approach can be a useful tool to analyze large and heterogeneous gene expression datasets. The method is able to identify complex relationships among genes and conditions that are difficult to identify by standard clustering algorithms.}, author = {Pedro Carmona-Saez and Roberto D Pascual-Marqui and Francisco Tirado and Jose Maria Carazo and Alberto Pascual-Montano}, doi = {10.1186/1471-2105-7-78}, file = {:home/renaud/Documents/articles/NMF/Biclustering of gene expression data by non-smooth non-negative matrix factorization\_Carmona-Saez2006.pdf:pdf}, issn = {1471-2105}, journal = {BMC bioinformatics}, keywords = {Algorithms,Artificial Intelligence,Automated,Automated: methods,Cluster Analysis,Factor Analysis,Gene Expression Profiling,Gene Expression Profiling: methods,Oligonucleotide Array Sequence Analysis,Oligonucleotide Array Sequence Analysis: methods,Pattern Recognition,Statistical}, pages = {78}, pmid = {16503973}, title = {{Biclustering of gene expression data by Non-smooth Non-negative Matrix Factorization.}}, url = {http://www.ncbi.nlm.nih.gov/pubmed/16503973}, volume = {7}, year = {2006}, } @Article{Wang2006, abstract = {BACKGROUND: Non-negative matrix factorisation (NMF), a machine learning algorithm, has been applied to the analysis of microarray data. A key feature of NMF is the ability to identify patterns that together explain the data as a linear combination of expression signatures. Microarray data generally includes individual estimates of uncertainty for each gene in each condition, however NMF does not exploit this information. Previous work has shown that such uncertainties can be extremely valuable for pattern recognition. RESULTS: We have created a new algorithm, least squares non-negative matrix factorization, LS-NMF, which integrates uncertainty measurements of gene expression data into NMF updating rules. While the LS-NMF algorithm maintains the advantages of original NMF algorithm, such as easy implementation and a guaranteed locally optimal solution, the performance in terms of linking functionally related genes has been improved. LS-NMF exceeds NMF significantly in terms of identifying functionally related genes as determined from annotations in the MIPS database. CONCLUSION: Uncertainty measurements on gene expression data provide valuable information for data analysis, and use of this information in the LS-NMF algorithm significantly improves the power of the NMF technique.}, author = {Guoli Wang and Andrew V Kossenkov and Michael F Ochs}, doi = {10.1186/1471-2105-7-175}, file = {:home/renaud/Documents/articles/NMF/LS-NMF A modified non-negative matrix factorization algorithm utilizing uncertainty estimates\_Wang2006.pdf:pdf}, issn = {1471-2105}, journal = {BMC bioinformatics}, keywords = {Algorithms,Automated,Automated: methods,Databases,Genetic,Messenger,Messenger: genetics,Oligonucleotide Array Sequence Analysis,Oligonucleotide Array Sequence Analysis: methods,Oligonucleotide Array Sequence Analysis: statistic,Pattern Recognition,RNA,Uncertainty}, month = {jan}, pages = {175}, pmid = {16569230}, title = {{LS-NMF: a modified non-negative matrix factorization algorithm utilizing uncertainty estimates.}}, url = {http://www.ncbi.nlm.nih.gov/pubmed/16569230}, volume = {7}, year = {2006}, } @Article{VanBenthem2004, author = {Mark H. {Van Benthem} and Michael R. Keenan}, doi = {10.1002/cem.889}, file = {:home/renaud/Documents/articles/NMF/Fast algorithm for the solution of large-scale non-negativity-constrained least squares problems\_Benthem2005.pdf:pdf}, issn = {0886-9383}, journal = {Journal of Chemometrics}, keywords = {als,mcr,nnls,non-negativity}, month = {oct}, number = {10}, pages = {441--450}, title = {{Fast algorithm for the solution of large-scale non-negativity-constrained least squares problems}}, url = {http://doi.wiley.com/10.1002/cem.889}, volume = {18}, year = {2004}, } @Article{Golub1999, abstract = {Although cancer classification has improved over the past 30 years, there has been no general approach for identifying new cancer classes (class discovery) or for assigning tumors to known classes (class prediction). Here, a generic approach to cancer classification based on gene expression monitoring by DNA microarrays is described and applied to human acute leukemias as a test case. A class discovery procedure automatically discovered the distinction between acute myeloid leukemia (AML) and acute lymphoblastic leukemia (ALL) without previous knowledge of these classes. An automatically derived class predictor was able to determine the class of new leukemia cases. The results demonstrate the feasibility of cancer classification based solely on gene expression monitoring and suggest a general strategy for discovering and predicting cancer classes for other types of cancer, independent of previous biological knowledge.}, author = {T R Golub and D K Slonim and P Tamayo and C Huard and M Gaasenbeek and J P Mesirov and H Coller and M L Loh and J R Downing and M a Caligiuri and C D Bloomfield and E S Lander}, file = {:home/renaud/Documents/articles/microarray/Molecular Classification of Cancer$\backslash$: Class Discovery and Class Prediction by Gene Expression\_Golub1999.pdf:pdf}, issn = {0036-8075}, journal = {Science (New York, N.Y.)}, keywords = {Acute Disease,Antineoplastic Combined Chemotherapy Protocols,Antineoplastic Combined Chemotherapy Protocols: th,Cell Adhesion,Cell Adhesion: genetics,Cell Cycle,Cell Cycle: genetics,Gene Expression Profiling,Homeodomain Proteins,Homeodomain Proteins: genetics,Humans,Leukemia, Myeloid,Leukemia, Myeloid: classification,Leukemia, Myeloid: drug therapy,Leukemia, Myeloid: genetics,Neoplasm Proteins,Neoplasm Proteins: genetics,Neoplasms,Neoplasms: classification,Neoplasms: genetics,Oligonucleotide Array Sequence Analysis,Oncogenes,Precursor Cell Lymphoblastic Leukemia-Lymphoma,Precursor Cell Lymphoblastic Leukemia-Lymphoma: cl,Precursor Cell Lymphoblastic Leukemia-Lymphoma: dr,Precursor Cell Lymphoblastic Leukemia-Lymphoma: ge,Predictive Value of Tests,Reproducibility of Results,Treatment Outcome}, month = {oct}, number = {5439}, pages = {531--7}, pmid = {10521349}, title = {{Molecular classification of cancer: class discovery and class prediction by gene expression monitoring.}}, url = {http://www.ncbi.nlm.nih.gov/pubmed/10521349}, volume = {286}, year = {1999}, } @Article{Cichocki2008, author = {Andrzej Cichocki and Rafal Zdunek and Shun-ichi Amari}, file = {:home/renaud/Documents/articles/NMF/Nonnegative Matrix and Tensor Factorization\_Cichocki2008.pdf:pdf}, journal = {IEEE Signal Processing Magazine}, pages = {142--145}, title = {{Nonnegative matrix and tensor factorization}}, volume = {25}, year = {2008}, } @article{Berry2007, author = {Berry, M.W. and Browne, M and Langville, Amy N. and Pauca, V.P. and Plemmons, R.J.}, file = {:home/renaud/Documents/articles/NMF/Algorithms and Applications for Approximate Nonnegative Matrix Factorization\_Berry2006.pdf:pdf}, journal = {Computational Statistics \& Data Analysis}, number = {1}, pages = {155--173}, publisher = {Elsevier}, title = {{Algorithms and applications for approximate nonnegative matrix factorization}}, url = {http://www.sciencedirect.com/science/article/pii/S0167947306004191}, volume = {52}, year = {2007} } @article{Chu2004, author = {Chu, M and Diele, F and Plemmons, R and Ragni, S}, file = {:home/renaud/Documents/articles/NMF/Optimality, computation, and interpretations of nonnegative matrix factorizations\_Chu2004.pdf:pdf}, journal = {SIAM Journal on Matrix Analysis}, keywords = {ellipsoid method,gradient method,kuhn-,least squares,linear model,mass balance,newton method,nonnegative matrix factorization,quadratic programming,reduced quadratic model,tucker condition}, pages = {4--8030}, publisher = {Citeseer}, title = {{Optimality, computation, and interpretation of nonnegative matrix factorizations}}, url = {http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.61.5758}, year = {2004} } @article{Gao2005, abstract = {MOTIVATION: Identifying different cancer classes or subclasses with similar morphological appearances presents a challenging problem and has important implication in cancer diagnosis and treatment. Clustering based on gene-expression data has been shown to be a powerful method in cancer class discovery. Non-negative matrix factorization is one such method and was shown to be advantageous over other clustering techniques, such as hierarchical clustering or self-organizing maps. In this paper, we investigate the benefit of explicitly enforcing sparseness in the factorization process. RESULTS: We report an improved unsupervised method for cancer classification by the use of gene-expression profile via sparse non-negative matrix factorization. We demonstrate the improvement by direct comparison with classic non-negative matrix factorization on the three well-studied datasets. In addition, we illustrate how to identify a small subset of co-expressed genes that may be directly involved in cancer.}, author = {Gao, Yuan and Church, George}, doi = {10.1093/bioinformatics/bti653}, file = {:home/renaud/Documents/articles/NMF/Improving molecular cancer class discovery through sparse non-negative matrix factorization\_Gao2005.pdf:pdf}, issn = {1367-4803}, journal = {Bioinformatics (Oxford, England)}, keywords = {Algorithms,Biological,Biological: classification,Biological: metabolism,Computer-Assisted,Computer-Assisted: methods,Diagnosis,Factor Analysis,Gene Expression Profiling,Gene Expression Profiling: methods,Humans,Neoplasm Proteins,Neoplasm Proteins: classification,Neoplasm Proteins: metabolism,Neoplasms,Neoplasms: classification,Neoplasms: diagnosis,Neoplasms: metabolism,Oligonucleotide Array Sequence Analysis,Oligonucleotide Array Sequence Analysis: methods,Reproducibility of Results,Sensitivity and Specificity,Statistical,Tumor Markers}, month = nov, number = {21}, pages = {3970--5}, pmid = {16244221}, title = {{Improving molecular cancer class discovery through sparse non-negative matrix factorization.}}, url = {http://www.ncbi.nlm.nih.gov/pubmed/16244221}, volume = {21}, year = {2005} } @article{Roux2008, author = {Roux, Jonathan Le and de Cheveign\'{e}, Alain}, file = {:home/renaud/Documents/articles/NMF/Adaptive Template Matching with Shift-Invariant Semi-NMF\_Le Roux2008.pdf:pdf}, journal = {Science And Technology}, title = {{Adaptive template matching with shift-invariant semi-NMF}}, url = {http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.143.6846&rep=rep1&type=pdf}, year = {2008} } @article{Ding2010, abstract = {We present several new variations on the theme of nonnegative matrix factorization (NMF). Considering factorizations of the form X=FG(T), we focus on algorithms in which G is restricted to containing nonnegative entries, but allowing the data matrix X to have mixed signs, thus extending the applicable range of NMF methods. We also consider algorithms in which the basis vectors of F are constrained to be convex combinations of the data points. This is used for a kernel extension of NMF. We provide algorithms for computing these new factorizations and we provide supporting theoretical analysis. We also analyze the relationships between our algorithms and clustering algorithms, and consider the implications for sparseness of solutions. Finally, we present experimental results that explore the properties of these new methods.}, author = {Ding, Chris and Li, Tao and Jordan, Michael I}, doi = {10.1109/TPAMI.2008.277}, file = {:home/renaud/Documents/articles/NMF/Convex and Semi-Nonnegative Matrix Factorization\_Ding2009.pdf:pdf}, issn = {1939-3539}, journal = {IEEE transactions on pattern analysis and machine intelligence}, month = jan, number = {1}, pages = {45--55}, pmid = {19926898}, title = {{Convex and semi-nonnegative matrix factorizations.}}, url = {http://www.ncbi.nlm.nih.gov/pubmed/19926898}, volume = {32}, year = {2010} }NMF/inst/tests/0000755000176000001440000000000012307621244013042 5ustar ripleyusersNMF/inst/tests/runit.NMFfit-class.r0000644000176000001440000001410212234465004016610 0ustar ripleyusers#' Unit Testing script for NMF package: NMFfit objects #' #' @author Renaud Gaujoux #' @creation 22 April 2009 # make the internal functions/objects visible if( isNamespaceLoaded('NMF') ){ NMFfitX <- NMF:::NMFfitX } .TestSeed <- 123456 .testData <- function(n=20, r=3, m=10, ...){ syntheticNMF(n, r, m, ...) } #' Unit test for the number of iterations test.niter <- function(){ # set random seed set.seed(.TestSeed) # generate random target matrix r <- 3; V <- .testData(r=r) # fit an iterative model res <- nmf(V,r) checkTrue(!is.null(niter(res)), "The number of iterations is set by the default -- iterative -- algorithm") # fit with SNMF/R(L) res <- nmf(V,r, method='snmf/r') checkTrue(!is.null(niter(res)), "The number of iterations is set by the SNMF/R algorithms") res <- nmf(V,r, method='snmf/l') checkTrue(!is.null(niter(res)), "The number of iterations is set by the SNMF/R algorithms") # fix number of iterations res <- nmf(V, r, .stop=function(strat, i, target, data, ...) if(i>=10) TRUE else FALSE) checkEquals(niter(res), 10, "The number of iterations is correctly set in the case of a fixed number of iterations .stop function") } test.isNMFfit <- function(){ # set random seed set.seed(.TestSeed) # generate random target matrix r <- 3; V <- .testData(r=r) # single run res <- nmf(V, 2) checkTrue(isNMFfit(res), "isNMFfit returns TRUE on the result of a single run") # multiple runs - keeping single fit resm <- nmf(V, 2, nrun=3) checkTrue(isNMFfit(resm), "isNMFfit returns TRUE on the result of a multiple runs - keep best") # multiple runs - keeping all fits resM <- nmf(V, 2, nrun=3, .opt='k') checkTrue(isNMFfit(resM), "isNMFfit returns TRUE on the result of a multiple runs - keep best") # with a list of results checkEquals(isNMFfit(list(res, resm, resM)), rep(TRUE, 3), "isNMFfit returns [TRUE TRUE TRUE] on a list of 3 NMF results") checkEquals(isNMFfit(list(res, resm, resM, 'not a result')), c(rep(TRUE, 3), FALSE), "isNMFfit returns [TRUE TRUE TRUE FALSE] on a list of 3 NMF results + 1 not result") checkEquals(isNMFfit(list(res, resm, resM), recursive=FALSE), FALSE, "isNMFfit returns FALSE on a list of 3 NMF results when 'recursive=FALSE'") } #' Unit test for function nmf.equal test.nmf.equal <- function(){ check.nmf.equal <- function(type=c('NMF', 'NMFfit', 'NMFfitX1', 'NMFfitXn')){ n <- 100; r <- 3; m <- 20 # create an NMF model set.seed(123) V <- rmatrix(n, m) resM <- nmf(V, 3) resM <- NMFfitX(list(resM)) ## utility functions create.type <- function(type, obj){ a <- if( type=='NMF' ) fit(obj) else if( type=='NMFfit' ) minfit(obj) else if( type=='NMFfitX1' ) NMFfitX(obj, .merge=TRUE) else obj if( type != 'NMF' ){ #print(class(a)) stopifnot( class(a) == type ) } a } add.diff <- function(obj, addon){ basis(fit(obj[[1]])) <- basis(fit(obj[[1]])) + rmatrix(basis(fit(obj[[1]])), max=addon) obj } ## a <- create.type(type, resM) sapply(c('NMF', 'NMFfit', 'NMFfitX1', 'NMFfitXn'), function(type2){ b <- create.type(type2, resM) type.pair <- paste(type, "x", type2) # on same object checkTrue( nmf.equal(a, a), paste(type.pair, "- Default: returns TRUE on same object")) checkTrue( nmf.equal(a, a, identical=TRUE), paste(type.pair, "- With identical=TRUE: returns TRUE on same object")) checkTrue( nmf.equal(a, a, identical=FALSE), paste(type.pair, "- With identical=FALSE: returns TRUE on same object")) checkTrue( nmf.equal(a, a, identical=FALSE, tol=0), paste(type.pair, "- With identical=FALSE, tol=0: returns TRUE on same object")) checkTrue( nmf.equal(a, a, tol=0), paste(type.pair, "- With only argument tol=0: returns TRUE on same object")) # on almost same object b <- add.diff(resM, .Machine$double.eps ^ 0.6) b <- create.type(type2, b) checkTrue( !nmf.equal(a, b), paste(type.pair, "- Default: returns FALSE on almost same object")) checkTrue( !nmf.equal(a, b, identical=TRUE), paste(type.pair, "- With identical=TRUE: returns FALSE on almost same object")) checkTrue( nmf.equal(a, b, identical=FALSE), paste(type.pair, "- With identical=FALSE: returns TRUE on almost same object")) checkTrue( nmf.equal(a, b, identical=FALSE, tol=10^-4) , paste(type.pair, "- With identical=FALSE, tol > difference: returns TRUE on almost same object")) checkTrue( nmf.equal(a, b, tol=10^-4) , paste(type.pair, "- With only argument tol > difference: returns TRUE on almost same object")) checkTrue( !isTRUE(nmf.equal(a, b, identical=FALSE, tolerance= .Machine$double.eps * 2)) , paste(type.pair, "- With identical=FALSE, tol < difference: returns FALSE on almost same object")) checkTrue( !isTRUE(nmf.equal(a, b, tolerance= .Machine$double.eps * 2)) , paste(type.pair, "- With only argument tol < difference: returns FALSE on almost same object")) # on very different object b <- add.diff(resM, 10) b <- create.type(type2, b) checkTrue( !nmf.equal(a, b), paste(type.pair, "- Default: returns FALSE on very different object")) checkTrue( !nmf.equal(a, b, identical=TRUE), paste(type.pair, "- With identical=TRUE: returns FALSE on very different object")) checkTrue( !isTRUE(nmf.equal(a, b, identical=FALSE)), paste(type.pair, "- With identical=FALSE: returns FALSE on very different object")) checkTrue( nmf.equal(a, b, identical=FALSE, tol=11) , paste(type.pair, "- With identical=FALSE, tol > difference: returns TRUE on very different object")) checkTrue( nmf.equal(a, b, tol=11) , paste(type.pair, "- With only argument tol > difference: returns TRUE on very different object")) checkTrue( !isTRUE(nmf.equal(a, b, identical=FALSE, tol=0.5)) , paste(type.pair, "- With identical=FALSE, tol < difference: returns FALSE on very different object")) checkTrue( !isTRUE(nmf.equal(a, b, tol=0.5)) , paste(type.pair, "- With only argument tol < difference: returns FALSE on very different object")) }) } sapply(c('NMF', 'NMFfit', 'NMFfitX1', 'NMFfitXn'), check.nmf.equal) } test.deviance <- function(){ }NMF/inst/tests/runit.interface.r0000644000176000001440000012656512305630424016342 0ustar ripleyusers#' Unit Testing script for NMF package: NMF interface for algorithms. #' #' @author Renaud Gaujoux #' @creation 14 May 2009 library(rngtools) checkIdenticalRNG <- checkRNG # make the internal functions/objects visible if( isNamespaceLoaded('NMF') ){ seed <- NMF:::seed # nmfUnregister <- NMF:::nmfUnregister name <- NMF:::name `name<-` <- NMF:::`name<-` } .testData <- function(n=20, r=3, m=10, ...){ syntheticNMF(n, r, m, ...) } test.registry <- function(){ checkNotNull <- function(x, ...) checkTrue(!is.null(x), ...) # register function as a method dummy.method <- function(){} # methods that don't exist # checkException(nmfUnregister('algo.tata'), 'Unregister a method without specifying the registry name') # checkTrue(nmfUnregister('algo.tata', 'algorithm'), 'Unregister a method that does not exist: should not generate an error') checkIdentical(removeNMFMethod('algo.tata'), FALSE, 'removeNMFMethod a method that does not exist: should not generate an error') checkException( nmfAlgorithm('algo.toto'), 'Try to access a method that does not exist: should generate an error') checkTrue(is.null(nmfAlgorithm('algo.toto', error=FALSE)), 'Try to access a method that does not exist with error=FALSE: should NOT generate an error and return NULL') # Registration of new methods # force un-registration of 'dummy' on exit on.exit({removeNMFMethod('dummy')}, add=TRUE) checkNotNull(setNMFMethod('dummy', dummy.method), 'Register works on dummy -- empty -- method') checkException(setNMFMethod('dummy', dummy.method), 'Try to register an algorithm with an existing name') checkNotNull(setNMFMethod('dummy', dummy.method, overwrite=TRUE), 'Overwrite an existing algorithm ') # Access to methods checkTrue( is(nmfAlgorithm('dummy'), 'NMFStrategyFunction'), 'Get method by exact match') checkTrue( is(nmfAlgorithm('dum'), 'NMFStrategyFunction'), 'Get method by partial match') checkEquals( name(nmfAlgorithm('dum')), 'dummy', "The method's full name is set in slot 'name'") } #' Utility function for \code{test.seed}: performs a set of test on a seeded object check.seed <- function(title, obj, V, r, expect.class){ checkTrue( isNMFfit(obj), paste(title, ": class returned is a valid NMF fit object") ) checkTrue( is(fit(obj), expect.class), paste(title, ": default class returned is ", expect.class) ) checkTrue( !is.empty.nmf(fit(obj)) , paste(title, ": Seeded object is not empty")) checkEquals( nbasis(obj), r , paste(title, ": Seeded object has correct rank")) checkEquals( nrow(obj), nrow(V) , paste(title, ": Seeded object has correct number of rows"), checkNames=FALSE) checkEquals( ncol(obj), ncol(V) , paste(title, ": Seeded object has correct number of columns"), checkNames=FALSE) } check.res <- function(title, obj, V, r, expect.class, algo=NULL, seed=NULL , rng=NULL, rngref=NULL){ # check the same thing as in the seed check.seed(title, obj, V, r, expect.class) # check if some slots are correctly set if( is.null(algo) ) algo <- nmf.getOption('default.algorithm') checkEquals( algorithm(obj), algo, paste(title, ": Slot 'method' is correctly set")) if( is.null(seed) ) seed <- nmf.getOption('default.seed') checkEquals( seeding(obj), seed, paste(title, ": Slot 'seed' is correctly set")) # rng if( !is.null(rng) ){ # check RNG checkTrue( !rng.equal(rng), paste(title, ": The RNG after the fit is different from the one used to sed the computation")) if( nrun(obj) == 1 ){ checkTrue(rng.equal(obj, rng), paste(title, ": The fit's RNG seed is correctly set")) }else{ if( is.list(rng) ){ if( is(obj, 'NMFfitXn') ) checkTrue( all(mapply(rng.equal, obj, rng)) , paste(title, ": The RNGs used in the multi-run computation are from the correct sequence")) } } # check RNG_1 rng1 <- if( is.list(rng) ) rng[[1]] else rng if( !is.null(rngref) ) checkTrue( !rng.equal(rng1, rngref), paste(title, ": The initial current RNG is different from the first RNG used in computation")) checkTrue(rng1.equal(obj, rng1), paste(title, ": The first fit's RNG seed is correctly set")) checkIdenticalRNG( getRNG1(obj), rng1, paste(title, ": The first RNG used in the computation is given by getRNG1")) } # ref rng if( !is.null(rngref) ){ checkTrue( rng.equal(rngref), paste(title, ": The current RNG was not affected by the computation")) if( is.null(rng) ) checkTrue( rng.equal(obj, rngref), paste(title, ": The fit's RNG is the same as the reference RNG")) } } #' Unit test for the interface function 'seed' test.seed <- function(){ # create a random target matrix r <- 3; V <- .testData(r=r) n <- nrow(V); m <- ncol(V); # test default call obj <- seed(V, r) check.seed('Call with rank', obj, V, r, 'NMFstd') # test call with numeric value obj <- seed(V, r, 123456) check.seed('Call with rank and numeric seed', obj, V, r, 'NMFstd') # test call with name and extra parameters obj <- seed(V, r, 'nndsvd', densify='average') check.seed('Call with name and extra parameters', obj, V, r, 'NMFstd') # test error when unused argument is used checkException(seed(V, r, 'random', toto=1), "Throw an error when: unused parameter is passed to seeding method") # test providing the class to instantiate class.in <- 'NMFOffset' obj <- seed(V, list(class.in, r)) check.seed('Call with class', obj, V, r, class.in) # test with an empty initalization object of another class: the class should not change class.in <- 'NMFOffset' obj <- nmfModel(r, model=class.in) obj <- seed(V, obj) check.seed('Call with object', obj, V, r, class.in) # test calls of methods checkException({obj <- seed(V, r, 'seed.toto')}, 'Error when calling with an undefined seeding method') checkTrue(inherits(seed(V, r, 'random'), 'NMFfit'), 'No error when calling with a defined seeding method') } #' Unit test for the interface function 'nmf': minimum default call test.nmf.default <- function(){ # set random seed set.seed(123456) # create a random target matrix r <- 3; V <- .testData(r=r) # run nmf with no argument check.res('Call with rank (only)' , nmf(V, r) , V, r, 'NMFstd') } #' Unit test for the interface function 'nmf': argument 'method' test.nmf.method <- function(){ # set random seed set.seed(123456) # create a random target matrix r <- 3; V <- .testData(r=r) # check errors checkException( nmf(V, r, 'zzz'), "Throw an error when: inexistent algorithm name") checkException( nmf(V, r, toto=3), "Throw an error when: unused argument is passed to algorithm") ## ARGUMENT: method # run nmf with only an algorithm name check.res('Call with algorithm name' , nmf(V, r, 'nsNMF') , V, r, 'NMFns', 'nsNMF') # run nmf with only an algorithm name (partial match) check.res('Call with algorithm name and partial match' , nmf(V, r, 'ns') , V, r, 'NMFns', 'nsNMF') old.rseed <- getRNG() res <- nmf(V, r, list('ns', 'br', 'lee')) checkIdentical(names(res), c('nsNMF', 'brunet', 'lee'), "Argument list(): names are set correctly to the complete method names") checkTrue( all(sapply(res, function(x) identical(getRNG(x), getRNG(res[[1]])))), "Initial RNG settings are the same for each method") checkTrue( !identical(old.rseed, getRNG()), "RNG setting is different after the run" ) new.rseed <- getRNG() setRNG(old.rseed) nmf(V, r, 'lee') checkIdentical( new.rseed, getRNG(), "RNG setting after the run is the same as if one has run only the last method" ) # list of methods res <- nmf(V, r, list('ns', 'br', 'lee'), nrun=3) checkIdentical(names(res), c('nsNMF', 'brunet', 'lee'), "Argument list() + multiple run: names are set correctly to the complete method names") checkTrue( all(sapply(res, function(x) identical(getRNG1(x), getRNG1(res[[1]])))), "Argument list() + multiple runs: Initial RNG settings are the same for each method") ml <- list('ns', 'brunet', 'lee') checkException(nmf(V, r, ml, .parameters = 2:3), "Error if argument .parameters not a list") checkException(nmf(V, r, ml, .parameters = list(list(copy = TRUE))), "Error if argument .parameters has no names") checkException(nmf(V, r, ml, .parameters = list(br = list(), list(copy = TRUE))), "Error if argument .parameters has missing names") checkException(nmf(V, r, ml, .parameters = list(br = list(), brun = list(copy = TRUE))), "Error if argument .parameters has multiple matching names") checkWarning(nmf(V, r, ml, .parameters = list(br = list(aaa = 1))), TRUE, "Error if unused argument in selected method-specific parameters") checkWarning(nmf(V, r, ml, .parameters = list(br = list(), toto = list())), TRUE, "Warning if unused elements in .parameters") checkTrue(all(isNMFfit(res <- nmf(V, r, ml, seed = 123, .parameters = list(br = list(maxIter = 10), ns = list(maxIter = 2))))) , "List of methods working if called with correct .parameters") checkIdentical( niter(res$nsNMF), 2L, ) checkIdentical( niter(res$brunet), 10L) res_lee <- nmf(V, r, 'lee', seed = 123) checkTrue( niter(res$lee) > 10L, "Method without method-specific parameter specification correctly runs without them: niter > 10L" ) checkIdentical( niter(res$lee), niter(res$lee), "Method without method-specific parameter specification correctly runs without them: niter equal" ) checkTrue( nmf.equal(res$lee, res_lee), "Method without method-specific parameter specification correctly runs without them: identical result" ) } #' Unit test for multiple rank test.nmf.multirank <- function(){ # set random seed set.seed(123456) # create a random target matrix r <- 3; V <- .testData(r=r) old.rseed <- getRNG() ranks <- 2:4 old.rseed <- getRNG() res <- nmf(V, ranks, nrun=1) checkTrue( is(res, 'NMF.rank'), "Result is a NMF.rank object") checkIdentical(names(res), c('measures', 'consensus', 'fit'), "result names are corrects") checkIdentical(names(res$fit), as.character(ranks), "names of fits are the ranks as character strings") fits <- res$fit checkTrue( all(sapply(fits, function(x) identical(getRNG(x), getRNG(fits[[1]])))), "Initial RNG settings are the same for each rank") checkTrue( !identical(old.rseed, getRNG()), "RNG setting is different after the run" ) new.rseed <- getRNG() setRNG(old.rseed) nmf(V, tail(ranks, 1)) checkIdentical( new.rseed, getRNG(), "RNG setting after the run is the same as if one has run only the last rank" ) res <- nmf(V, ranks, nrun=3) checkTrue( is(res, 'NMF.rank'), "multiple runs: Result is a NMF.rank object") checkIdentical(names(res), c('measures', 'consensus', 'fit'), "multiple runs: result names are corrects") checkIdentical(names(res$fit), as.character(ranks), "multiple runs: names of fits are the ranks as character strings") fits <- res$fit checkTrue( all(sapply(fits, function(x) identical(getRNG1(x), getRNG1(fits[[1]])))), "multiple runs: Initial RNG settings are the same for each rank") } #' Unit test for fault tolerance of .Random.seed test.nmf.seed.fault <- function(){ # set random seed set.seed(123456) # create a random target matrix r <- 3; V <- .testData(r=r) # .Random.seed is not changed after an error in the run os <- .Random.seed try(res <- nmf(V, r, method=function(...){})) checkIdentical( os, .Random.seed, ".Random.seed is NOT changed after error in single run without seed") # os <- .Random.seed try(res <- nmf(V, r, nrun=3, method=function(...){}, .opt='-p')) checkIdentical(os, .Random.seed, ".Random.seed is NOT changed after error in multiple runs without seed (sapply)") # os <- .Random.seed try(res <- nmf(V, r, nrun=3, method=function(...){}, .opt='P2')) checkIdentical(os, .Random.seed, ".Random.seed is NOT changed after error in multiple runs without seed (foreach-MC)") # os <- .Random.seed try(res <- nmf(V, r, nrun=3, method=function(...){}, .opt='P1')) checkIdentical(os, .Random.seed, ".Random.seed is NOT changed after error in multiple runs without seed (foreach-SEQ)") } #' Unit test for the interface function 'nmf': argument 'seed' test.nmf.seed.argument <- function(){ # set random seed set.seed(123456) # create a random target matrix r <- 3; V <- .testData(r=r) ## ARGUMENT: seed # check errors checkException( nmf(V, r, seed='zzz'), "Throw an error when: inexistent seeding method name") checkException( nmf(V, r, seed=matrix(1,2,2)), "Throw an error when: invalid object as seeding method") checkException( nmf(V, r, seed=list('zzz')), "Throw an error when: inexistent seeding method name (passed as list)") checkException( nmf(V, r, seed=list(method='zzz')), "Throw an error when: inexistent seeding method name (passed as named list)") checkException( nmf(V, r, seed=list(toto=1, method='random')), "Throw an error when: unused argument is passed to seeding method") checkException( nmf(V, r, seed=numeric()), "Throw an error when: seed argument is an empty numeric") checkException( nmf(V, r, seed=c(1,2)), "Throw an error when: seed argument is a numeric of invalid length (2)") checkException( nmf(V, r, seed=rep(5,5)), "Throw an error when: seed argument is an invalid numeric value for .Random.seed (7)") # run nmf with only a seeding method name set.seed(123) rngRef <- getRNG() check.res('Call with only a NON random seeding method name' , nmf(V, r, seed='nndsvd') , V, r, 'NMFstd', seed='nndsvd', rngref=rngRef) # run nmf with only a seeding method name partially matched check.res('Call with only a NON random seeding method name partially match' , nmf(V, r, seed='nnd') , V, r, 'NMFstd', seed='nndsvd') # run nmf with 'random' seeding method set.seed(1234) rngRef <- getRNG() check.res('Call with "random" seeding method name' , res <- nmf(V, r, seed='random') , V, r, 'NMFstd', seed='random', rng=rngRef) # run nmf with numeric seed msg <- function(...) paste("Call with only a numerical seed:", ...) rngRef <- getRNG() s <- nextRNG(123456) check.res(msg() , res <- nmf(V, r, seed=123456) , V, r, 'NMFstd', seed='random', rng=s, rngref=rngRef) # run nmf with 6-length numeric seed msg <- function(...) paste("Call with a 6-length numerical seed:", ...) runif(10) rngRef <- getRNG() nseed <- c(1,2,3,4,5,6) s <- RNGseq(1, nseed) check.res(msg() , res <- nmf(V, r, seed=nseed) , V, r, 'NMFstd', seed='random', rng=s, rngref=rngRef) # # run nmf with rstream object # msg <- function(...) paste("Call with only a rstream object:", ...) # rngRef <- getRNG() # s <- new('rstream.mrg32k3a') # check.res(msg() # , res <- nmf(V, r, seed=s) # , V, r, 'NMFstd', seed='random', rng=s, rngref=rngRef) # # run multi-nmf with numeric seed msg <- function(...) paste("Multirun - parallel + numeric seed (keep all):", ...) runif(10) rngRef <- getRNG() sRNG <- RNGseq(3, seed=5698) check.res(msg() , res <- nmf(V, r, nrun=3, seed=5698, .opt='kP') , V, r, 'NMFstd', seed='random', rng=sRNG, rngref=rngRef) # run multi-nmf with 7-length numeric seed (keep one) msg <- function(...) paste("Multirun - parallel + list of seeds (keep all):", ...) runif(10) rngRef <- getRNG() check.res(msg() , res2 <- nmf(V, r, nrun=3, seed=sRNG, .opt='kP') , V, r, 'NMFstd', seed='random', rng=sRNG, rngref=rngRef) checkIdenticalRNG( res2, res, msg("The best fit's RNG is the same as when seeding with corresponding single numeric seed")) # run multi-nmf with numeric seed (keep one) msg <- function(...) paste("Multirun - parallel + numeric seed (keep best):", ...) runif(10) res2 <- nmf(V, r, nrun=3, seed=5698, .opt='P') checkIdenticalRNG( res2, res, msg("The best fit's RNG is the same as when keeping all the fits")) checkIdenticalRNG( getRNG1(res2), sRNG[[1]], msg("The first RNG used in the computation of the NMFfitX1 object is given by getRNG1")) checkTrue( rng1.equal(res2, sRNG[[1]]), msg("The first RNG used in the computation is correct")) # run multi-nmf with 7-length numeric seed (keep one) msg <- function(...) paste("Multirun - parallel + single 7-length numeric seed (keep best):", ...) runif(10) res2 <- nmf(V, r, nrun=3, seed=sRNG[[1]], .opt='P') checkIdenticalRNG( res2, res, msg("The best fit's RNG is the same as when keeping all the fits")) checkIdenticalRNG( getRNG1(res2), sRNG[[1]], msg("The first RNG used in the computation of the NMFfitX1 object is given by getRNG1")) checkTrue( rng1.equal(res2, sRNG[[1]]), msg("The first RNG used in the computation is correct")) # # run multi-nmf with rstream object # msg <- function(...) paste("Multirun - parallel + rstream seed:", ...) # rngRef <- getRNG() # sRNG <- new('rstream.mrg32k3a') # check.res(msg() # , res <- nmf(V, r, nrun=3, seed=sRNG, .opt='kP') # , V, r, 'NMFstd', seed='random') # checkIdenticalRNG( res[[1]], sRNG, msg("The first RNG used in the computation is correct")) # checkTrue( !rng.equal(sRNG), msg("The current RNG is different from the first one used to seed the computation")) # checkTrue( rng.equal(rngRef), msg("The current RNG was not affected by the computation")) # checkIdenticalRNG( getRNG1(res), sRNG, msg("The first RNG used in the computation of the NMFfitXn object is given by getRNG1")) # run multi-nmf with rstream seed (keep one) msg <- function(...) paste("Multirun - parallel + rstream seed (keep best):", ...) runif(10) res2 <- nmf(V, r, nrun=3, seed=sRNG[[1]], .opt='P') checkIdenticalRNG( res2, res, msg("The best fit's RNG is the same as when keeping all the fits")) checkIdenticalRNG( getRNG1(res2), sRNG[[1]], msg("The first RNG used in the computation of the NMFfitX1 object is given by getRNG1")) # Seeding with NMF object obj.s <- rnmf(r, V) rngRef <- getRNG() res <- nmf(V, obj.s) check.res('Call with rank = ', res, V, r, 'NMFstd', 'brunet', 'NMF', rngref = rngRef) checkTrue( nmf.equal(res, nmf(V, obj.s)), 'Run with rank= is deterministic') res.s <- nmf(V, seed = obj.s) check.res('Call with seed = ', res, V, r, 'NMFstd', 'brunet', 'NMF', rngref = rngRef) checkTrue( nmf.equal(res, res.s), 'Run with rank= returns identical result as with seed=') # run nmf with only a seeding method name and some extra parameters check.res('Call with only a seeding method name and some extra parameters (element method first and not named)' , nmf(V, r, seed=list('nndsvd', densify='average')) , V, r, 'NMFstd', seed='nndsvd') check.res('Call with only a seeding method name and some extra parameters (element method second and named)' , nmf(V, r, seed=list(densify='average', method='nndsvd')) , V, r, 'NMFstd', seed='nndsvd') # run nmf with both algorithm and seeding method check.res('Call with both algorithm and seeding method' , nmf(V, r, 'lee', seed='nndsvd') , V, r, 'NMFstd', 'lee', 'nndsvd') } test.nmf.seed.equivalent <- function(){ # set random seed set.seed(123456) # create a random target matrix r <- 3; V <- .testData(r=r) # multiple run nmf with numeric seed is equivalent to set.seed before the call set.seed(1234) ss_SEQ <- nmf(V, r, nrun=3, .opt='k-p') # runif(10) SEQ <- nmf(V, r, nrun=3, seed=1234, .opt='k-p') checkTrue( nmf.equal(ss_SEQ, SEQ, all=TRUE) , "Multiple run using sapply with a numeric seed is equivalent to set.seed + run (sapply)") # multiple run nmf with numeric seed is equivalent to set.seed before the call set.seed(1234) ss_PAR <- nmf(V, r, nrun=3, .opt='kP2') runif(10) PAR <- nmf(V, r, nrun=3, seed=1234, .opt='kP2') checkTrue( nmf.equal(ss_SEQ, PAR, all=TRUE) , "Multiple run using foreach with a numeric seed is equivalent to set.seed + run (sapply)") checkTrue( nmf.equal(ss_PAR, PAR, all=TRUE) , "Multiple run using foreach with a numeric seed is equivalent to set.seed + run (foreach)") PAR_SEQ <- nmf(V, r, nrun=3, seed=1234, .opt='kP', .pbackend='seq') checkTrue( nmf.equal(PAR_SEQ, PAR, all=TRUE) , "Multiple run using foreach with a numeric seed is equivalent to foreach sequential with numeric seed") set.seed(1234) ss_PAR_SEQ <- nmf(V, r, nrun=3, .opt='kP', .pbackend='seq') checkTrue( nmf.equal(ss_PAR_SEQ, PAR, all=TRUE) , "Multiple run using foreach with a numeric seed is equivalent to set.seed + foreach sequential") #and: set.seed(1234) ss_SEQ_noR <- nmf(V, r, nrun=3, .opt='k-pR') runif(10) SEQ_noR <- nmf(V, r, nrun=3, seed=1234, .opt='k-pR') checkTrue( nmf.equal(ss_SEQ_noR, SEQ_noR, all=TRUE) , "Multiple run using sapply with a numeric seed WITHOUT option R is equivalent to set.seed + run (sapply) WITHOUT option R") checkTrue( !nmf.equal(SEQ_noR, SEQ, all=TRUE) , "Multiple run using sapply with a numeric seed WITHOUT option R is NOT equivalent to set.seed + run (sapply)") # # fits of multiple runs are not the same as the ones obtained from separate fits set.seed(1234) ss_SEPA <- replicate(3, nmf(V,r)) checkTrue( !nmf.equal(ss_SEPA, ss_SEQ, all=TRUE) , "Fits of multiple runs with sapply and a seed are NOT the same as the ones obtained from set.seed + separate fits") # but: checkTrue( nmf.equal(ss_SEPA, ss_SEQ_noR, all=TRUE) , "Fits of multiple runs WITHOUT option R with sapply and a seed are the same as the ones obtained from set.seed + separate fits") # checkTrue( !nmf.equal(ss_SEPA, PAR, all=TRUE) , "Fits of multiple runs with foreach and a seed are NOT the same as the ones obtained from set.seed + separate fits") # and: PAR_noR <- nmf(V, r, nrun=3, seed=1234, .opt='kP2-R') checkTrue( nmf.equal(PAR_noR, PAR, all=TRUE), "Option -R has no effect on true parallel computations") } test.nmf.seed.repro <- function(){ # set random seed set.seed(123456) # create a random target matrix r <- 3; V <- .testData(r=r) # check reproducibility res <- replicate(2, nmf(V, r, seed=123)) checkTrue( nmf.equal(res[[1]], res[[2]]), "Results are reproducible: single run" ) res <- replicate(2, nmf(V, r)) checkTrue( !nmf.equal(res[[1]], res[[2]]), "Results are NOT the same if not seeded: single run" ) # res <- replicate(2, nmf(V, r, nrun=3, seed=123, .opt='kP'), simplify=FALSE) checkTrue( nmf.equal(res[[1]], res[[2]], all=TRUE), "Results are reproducible: multiple run - Parallel" ) res <- replicate(2, nmf(V, r, nrun=3, .opt='kP'), simplify=FALSE) checkTrue( !nmf.equal(res[[1]], res[[2]]), "Results are NOT the same if not seeded: multiple run - Parallel" ) # res <- replicate(2, nmf(V, r, nrun=3, seed=123, .opt='k-p'), simplify=FALSE) checkTrue( nmf.equal(res[[1]], res[[2]], all=TRUE), "Results are reproducible: multiple run - sapply" ) res <- replicate(2, nmf(V, r, nrun=3, .opt='k-p'), simplify=FALSE) checkTrue( !nmf.equal(res[[1]], res[[2]]), "Results are NOT the same if not seeded: multiple run - sapply" ) # res <- list(nmf(V, r, nrun=3, seed=123, .opt='kP', .pbackend='seq') , nmf(V, r, nrun=3, seed=123, .opt='kP', .pbackend='mc')) checkTrue( nmf.equal(res[[1]], res[[2]], all=TRUE), "Identical results from seeded foreach MC and SEQ" ) res <- list(nmf(V, r, nrun=3, .opt='kP', .pbackend='seq') , nmf(V, r, nrun=3, .opt='kP', .pbackend='mc')) checkTrue( !nmf.equal(res[[1]], res[[2]], all=TRUE), "NON-identical results from non-seeded foreach MC and SEQ" ) } #' Unit test for the interface function 'nmf': argument 'model' test.nmf.model <- function(){ # set random seed set.seed(123456) # create a random target matrix r <- 3; V <- .testData(r=r) ## ARGUMENT: model # run nmf with empty argument'model' check.res("Call with empty argument 'model'" , nmf(V, r, model=list()) , V, r, 'NMFstd') # run nmf with bad types in 'model' checkException(nmf(V, r, model=NA), "Error if there argument 'model' is of a bad type: NA") checkException(nmf(V, r, model='toto'), "Error if there argument 'model' is of a bad type: character") checkException(nmf(V, r, model=12), "Error if there argument 'model' is of a bad type: numeric") # run nmf with not named element in argument 'model' checkException(nmf(V, r, model=list('toto')), "Error if there is a not named element in argument 'model'") # run nmf with bad slot name in argument 'model' checkException(nmf(V, r, model=list(toto=5)), "Error if there is a bad slot name in argument 'model'") # run nmf specifying arguments for initialization in argument 'model' res <- nmf(V, r, 'nsNMF', model=list(theta=0.6)) check.res("Call with argument 'model' to specify extra initialization parameter" , res , V, r, 'NMFns', 'nsNMF') checkEquals(fit(res)@theta, 0.6 , "Call algo:nsNMF with theta in argument 'model': argument correctly passed to model") } str_dim <- NMF:::str_dim test.nmfModel.formula <- function(){ set.seed(123456) r <- 3 V <- .testData(r = r) w <- rmatrix(nrow(V), r) h <- rmatrix(r, ncol(V)) cx <- runif(ncol(V)) bx <- runif(nrow(V)) .check <- function(res, dims, msg, cterm = NULL, bterm = NULL){ .msg <- function(...) paste0(msg, ': ', ...) checkTrue(isNMFfit(res), .msg('Result is an NMFfit object')) checkEquals(dim(res), dims, .msg('Dimensions [', str_dim(res), '] are as expected [', str_dim(dims=dims), ']')) # check fixed terms don't change if( !is.null(cterm) ){ if( is.null(dim(cterm)) ) cterm <- matrix(cterm, 1L) else if( is.data.frame(cterm) ) t(as.matrix(cterm)) else if( !is.matrix(cterm) ) stop("Unexpected error: invalid data type [", class(cterm), ']') n <- nrow(cterm) ft <- coef(res)[tail(1:nbasis(res), n), , drop = FALSE] dimnames(ft) <- NULL checkIdentical(cterm, ft, "Fixed coef term don't change") } if( !is.null(bterm) ){ if( is.null(dim(bterm)) ) bterm <- matrix(bterm, ncol = 1L) else if( is.data.frame(bterm) ) as.matrix(bterm) else if( !is.matrix(cterm) ) stop("Unexpected error: invalid data type [", class(bterm), ']') n <- ncol(bterm) ft <- basis(res)[, tail(1:nbasis(res), n), drop = FALSE] dimnames(ft) <- NULL checkIdentical(bterm, ft, "Fixed basis term don't change") } } # coef terms .check(nmf(V ~ cx), c(dim(V), 1L), cterm = cx, 'Single coef term') .check(nmf(V ~ h), c(dim(V), nrow(h)), cterm = h, 'Matrix coef term') .check(nmf(t(V) ~ t(w)), c(dim(t(V)), ncol(w)), cterm = t(w), 'Matrix coef term (transpose)') .check(nmf(V ~ data.frame(t(h))), c(dim(V), nrow(h)), cterm = h, 'Data frame coef term') # basis terms # .check(nmf(V ~ bx), c(dim(V), 1L), bterm = bx, 'Single basis term') # .check(nmf(V ~ w), c(dim(V), ncol(w)), bterm = w, 'Matrix basis term') # .check(nmf(V ~ data.frame(w)), c(dim(V), ncol(w)), bterm = w, 'Data frame basis term') } #' Unit test for the interface function 'nmf': argument '...' test.nmf.dots <- function(){ # set random seed set.seed(123456) # create a random target matrix r <- 3; V <- .testData(r=r) ## ARGUMENT: ... # run nmf with unused parameter in '...' checkException(nmf(V, r, toto=5), "Error if there is an unused parameter in '...'") # run nmf forcing using argument in '...' for algorithm checkException(nmf(V, r, 'nsNMF', model=list(), theta=0.6), "Forcing argument to go to algo: error if there is an unused parameter in '...'") # run nmf specifying arguments for initialization in argument '...' res <- nmf(V, r, 'nsNMF', theta=0.6) check.res("Call with argument '...' to specify extra initialization parameter" , res , V, r, 'NMFns', 'nsNMF') checkEquals(fit(res)@theta, 0.6 , "Call algo:nsNMF with theta in argument '...': argument correctly passed to model") } test.nmf.callback <- function(){ # create a random target matrix r <- 3; V <- .testData(r=r) # check that the result of the callback are stored in the result object cb <- function(object, i){ 1 } res <- nmf(V, r, nrun=3, .callback=cb, .opt='P') checkEquals(res$.callback, rep(1, 3), 'Result of callback is in: res$.callback (PAR)') res <- nmf(V, r, nrun=3, .callback=cb, .opt='-p') checkEquals(res$.callback, rep(1, 3), 'Result of callback is in: res$.callback (SEQ)') # check that callback can make use of the result of each run cb <- algorithm res <- nmf(V, r, nrun=3, .callback=cb, .opt='P') checkEquals(res$.callback, rep('brunet', 3), 'Result of callback can use the result object of each run (PAR)') res <- nmf(V, r, nrun=3, .callback=cb, .opt='-p') checkEquals(res$.callback, rep('brunet', 3), 'Result of callback can use the result object of each run (SEQ)') # check that the callback is not used with option 'keep.all' cb <- function(object, i){ stop() } checkWarning(res <- nmf(V, r, 'br', nrun=3, .callback=cb, .opt='Pk'), "discarding argument .*\\.callback") checkTrue( is(res, 'NMFfitXn'), "Callback function is not used with option 'keep.all=TRUE' (PAR)") checkWarning(res <- nmf(V, r, 'br', nrun=3, .callback=cb, .opt='k-p'), "discarding argument .*\\.callback") checkTrue( is(res, 'NMFfitXn'), "Callback function is not used with option 'keep.all=TRUE' (SEQ)") # check that an error in the callback function stops the computation with an error cb <- function(object, i){ stop('BIG ERROR') } checkTrue(isNMFfit(res <- nmf(V, r, 'br', nrun=3, .callback=cb, .opt='P')) , 'Error in callback function does not stop the copmutation (PAR)') checkTrue(is.list(res$.callback), 'res$.callback is a list when there is an error (PAR)') checkEquals(sapply(res$.callback, function(x) is(x, 'error')), rep(TRUE, 3), checkNames = FALSE , 'Error in callback function returns errors in res$.callback (PAR)') checkTrue(isNMFfit(res <- nmf(V, r, 'br', nrun=3, .callback=cb, .opt='-p')), 'Error in callback function does not stop the copmutation (SEQ)') checkTrue(is.list(res$.callback), 'res$.callback is a list when there is an error (SEQ)') checkEquals(sapply(res$.callback, function(x) is(x, 'error')), rep(TRUE, 3), checkNames = FALSE , 'Error in callback function returns errors in res$.callback (SEQ)') # simplification from list if no error res <- nmf(V, r, 'br', nrun=3, .callback=summary, .opt='P') checkTrue(is.matrix(res$.callback), 'res$.callback is a list when there is NO error (PAR)') res <- nmf(V, r, 'br', nrun=3, .callback=summary, .opt='P-S') checkTrue(is.list(res$.callback), 'res$.callback is a list when there is NO error (PAR) and simplifyCB=FALSE') res <- nmf(V, r, 'br', nrun=3, .callback=summary, .opt='-p') checkTrue(is.matrix(res$.callback), 'res$.callback is a list when there is NO error (SEQ)') res <- nmf(V, r, 'br', nrun=3, .callback=summary, .opt='-pS') checkTrue(is.list(res$.callback), 'res$.callback is a list when there is NO error (SEQ) and simplifyCB=FALSE') # # no simplification from list if there is at least one error cb <- function(object, i){ if( i ==1 ) stop('BIG ERROR ', i); summary(object) } res <- nmf(V, r, 'br', nrun=3, .callback=cb, .opt='P') checkTrue(is.list(res$.callback), 'res$.callback is a list when there is at least one error (PAR)') checkEquals(sapply(res$.callback, function(x) is(x, 'error')), c(TRUE, FALSE, FALSE), checkNames = FALSE , 'Error in callback function returns errors mixed with values in res$.callback (PAR)') res <- nmf(V, r, 'br', nrun=3, .callback=cb, .opt='-p') checkTrue(is.list(res$.callback), 'res$.callback is a list when there is at least one error (SEQ)') checkEquals(sapply(res$.callback, function(x) is(x, 'error')), c(TRUE, FALSE, FALSE), checkNames = FALSE , 'Error in callback function returns errors mixed with values in res$.callback (SEQ)') } test.nmf.options <- function(){ x <- rmatrix(20,10) .check <- function(msg, it, ...){ .msg <- function(...) paste(msg, ':', ...) res <- nmf(x, 2, ...) t <- residuals(res, track=TRUE) checkTrue( !is.null(names(t)), .msg("Track has names")) checkTrue( 0 == names(t)[1], .msg("First value in track is for iteration 0")) t <- t[-1] lags <- head(diff(as.numeric(names(t))), length(t)-2) checkIdentical( lags, rep(it, length(t)-2), .msg("Track interval is correct")) } .test <- function(msg, ...){ .check(paste(msg, '- single run'), ..., nrun=1) .check(paste(msg, '- multiple runs'), ..., nrun=3) } .test('Default call -> use option', nmf.getOption('track.interval'), .options='t') .test('Specified in .options="t5" -> use value from "t"', 5, .options='t5') nmf.options(track.interval=7) .test('Default call after changing option -> use new option', 7, .options='t') } test.nmf.custom <- function(){ # create a random target matrix r <- 3; V <- .testData(r=r) # define a dummy nmf algorithm with an argument with the same name as a slot my.algo <- function(x, seed, theta=0){ seed$extra.param <- theta seed } # check if everything works fine plain res <- nmf(V, r, my.algo, name='dummy') check.res('No argument (only name)' , res , V, r, 'NMFstd', 'dummy') checkEquals(res$extra.param, 0, "No argument: NO argument is provided to the algorithm") # check if everything works fine if model is an empty list res <- nmf(V, r, my.algo, name='dummy', model=list()) check.res("Argument 'model' an empty list" , res , V, r, 'NMFstd', 'dummy') checkEquals(res$extra.param, 0, "No argument: NO argument is provided to the algorithm") # with standard model: theta is not a model parameter => Error checkException(nmf(V, r, my.algo, name='dummy', model=list(theta=1)) , "Error when passing non model parameter in argument 'model', with same name as an algo parameter") # with standard model: extra argument in '...' used in algo res <- nmf(V, r, my.algo, name='dummy', theta=10) check.res('No argument (only name)' , res , V, r, 'NMFstd', 'dummy') checkEquals(res$extra.param, 10 , "NMFstd + Extra argument in '...': extra argument IS provided to the algorithm") # unsued extra argument in algorithm => Error checkException(nmf(V, r, my.algo, name='dummy', toto=1) , "Error if NMFstd + unused parameter in argument '...'") # run model nsNMF plain to get default value of theta res <- nmf(V, r, my.algo, model='NMFns') default.theta <- fit(res)@theta custom.theta <- 1 checkEquals(res$extra.param, 0, "NMFns + no args: extra argument is NOT provided to the algorithm") # with model nsNMF: the parameter should be used in the model if in argument 'model' res <- nmf(V, r, my.algo, name='dummy', model=list('NMFns', theta=custom.theta)) check.res("NMFns + With extra argument in argument 'model'" , res , V, r, 'NMFns', 'dummy') checkEquals(res$extra.param, 0, "NMFns + Argument in 'model': extra argument is NOT provided to the algorithm") checkEquals(fit(res)@theta, custom.theta, "NMFns + Argument in 'model': extra argument IS used in model") # with model nsNMF: the parameter should be used in the model if in # argument '...' and 'model' is not specified res <- nmf(V, r, my.algo, name='dummy', model='NMFns', theta=custom.theta) check.res("NMFns + With extra argument in argument '...' and 'model' a model name" , res , V, r, 'NMFns', 'dummy') checkEquals(res$extra.param, 0, "NMFns + Argument in '...', 'model' a model name: extra argument is NOT provided to the algorithm") checkEquals(fit(res)@theta, custom.theta, "NMFns + Argument in '...' and 'model' a model name: extra argument used in model") # with model nsNMF: the parameter should be used in the algorithm if in # argument '...' and 'model' is a list res <- nmf(V, r, my.algo, name='dummy', model=list('NMFns'), theta=1) check.res("NMFns + With extra argument in argument '...' and 'model' a list with model name" , res , V, r, 'NMFns', 'dummy') checkEquals(res$extra.param, 1, "NMFns + Argument in '...' and 'model' is a list with model name: extra argument IS provided to the algorithm") checkEquals(fit(res)@theta, default.theta, "NMFns + Argument in '...' and 'model' is list with model name: extra argument NOT used in model") # with model nsNMF: conflicts in names resolved passing different values # in arguments '...' and 'model' res <- nmf(V, r, my.algo, name='dummy', model=list('NMFns', theta=custom.theta), theta=1) check.res("NMFns + With extra argument in argument 'model'" , res , V, r, 'NMFns', 'dummy') checkEquals(res$extra.param, 1, "NMFns + Different values in argument in '...' and 'model': correct extra argument IS provided to the algorithm") checkEquals(fit(res)@theta, custom.theta, "NMFns + Different values in '...' and 'model': correct extra argument IS used in model") # TODO: run nmf with both algorithm and seeding method # test with negative input entries V.neg <- V V.neg[1,1] <- -1 checkException( nmf(V.neg, r, my.algo, name='dummy'), 'Throw an error if some input entries are negative and algoritham is declared NOT MIXED') res <- nmf(V.neg, r, my.algo, name='dummy', mixed=TRUE) check.res('Call with dummy MIXED algorithm on input with negative entries' , res , V.neg, r, 'NMFstd', 'dummy') # test with negative output entries my.algo <- function(target, start, param1, param2){ basis(start)[1,] <- -1 start } res <- nmf(V, r, my.algo, name='dummy') check.res('Call with dummy algorithm and MIXED output' , res , V, r, 'NMFstd', 'dummy') } #' Unit test for interface nmf: testing the passage of parameters test.nmf.parameters <- function(){ # define a dummy nmf algorithm my.algo <- function(target, start, param1, param2){ start } # create a random target matrix r <- 3; V <- .testData(r=r) check.res('Call with custom algo, model NMF', nmf(V, r, my.algo, name='dummy', model='NMFstd') , V, r, 'NMFstd', 'dummy', 'random') check.res('Call with custom algo, model NMFns', nmf(V, r, my.algo, name='dummy', model='NMFns') , V, r, 'NMFns', 'dummy', 'random') res <- nmf(V, r, my.algo, name='dummy', model=list('NMFns', theta=0.3)) check.res('Call with custom algo, model NMFns, theta in argument model: TEST RES', res , V, r, 'NMFns', 'dummy', 'random') checkEquals(fit(res)@theta, 0.3 , 'Call with custom algo, model NMFns, theta in argument model: argument correctly passed to model') res <- nmf(V, r, my.algo, name='dummy', model='NMFns', theta=0.3) check.res('Call with custom algo, model NMFns, theta in extra argument: TEST RES', res , V, r, 'NMFns', 'dummy', 'random') checkEquals(fit(res)@theta, 0.3 , 'Call with custom algo, model NMFns, theta in extra argument: argument correctly passed to model') res <- nmf(V, r, my.algo, name='dummy', model='NMFstd', param1=0.6) check.res('Call with custom algo, model NMFns, plus an extra argument: TEST RES', res , V, r, 'NMFstd', 'dummy', 'random') checkEquals(res@parameters, list(param1=0.6) , 'Call with custom algo, model NMFns, plus an extra argument: argument is passed correctly to algorithm') # redefine a dummy nmf algorithm my.algo2 <- function(target, start, theta){ start } res <- nmf(V, r, my.algo2, name='dummy', model=list('NMFns', theta=0.3), theta=0.6) check.res('Call with custom algo, model NMFns, theta in argument model AND extra argument: TEST RES', res , V, r, 'NMFns', 'dummy', 'random') checkEquals(fit(res)@theta, 0.3 , 'Call with custom algo, model NMFns, theta in argument model AND extra argument: argument model passed to model') checkEquals(res@parameters, list(theta=0.6) , 'Call with custom algo, model NMFns, theta in argument model AND extra argument: extra argument passed to algorithm') # test seeding # # define a dummy seeding method # my.seed <- function(model, target, param.s1, param.s2){ # rnmf(model, target) # } #res <- nmf(V, r, my.algo2, name='dummy', seed=list(), model=list('NMFns', theta=0.3), theta=0.6) } #' Unit test for the interface function: compare test.compare <- function(){ # create a random target matrix r <- 3; V <- .testData(r=r) m <- ncol(V) # init a list for the results res <- list() # compute NMF using different algorithms res$brunet <- nmf(V, r, 'brunet') res$ns <- nmf(V, r, 'ns') res$offset <- nmf(V, r, 'off') res$snmfr <- nmf(V, r, 'snmf/r') res$snmfl <- nmf(V, r, 'snmf/l') classes <- as.factor(sample(seq(r), m, replace=TRUE)) # compare the results with a list argument checkTrue( is.data.frame(compare(res, class=classes)), "Result of method 'compare' (list) is a data.frame" ) # compare the results with sorting checkTrue( is.data.frame(compare(res, class=classes, sort.by='method')) , "Result of method 'compare' (list) is a data.frame" ) # try with multiple runs res$brunet <- nmf(V, r, 'brunet', nrun=10) checkTrue( is.data.frame(compare(res, class=classes)), "Result of method 'compare' (list with multiple runs) is a data.frame" ) # try with multiple methods res <- nmf(V, r, list('brunet', 'lee', 'offset')) checkTrue( is.data.frame(compare(res, class=classes)), "Result of method 'compare' (list with multiple methods) is a data.frame" ) # try with multiple runs multiple methods res <- nmf(V, r, list('brunet', 'lee', 'ns'), nrun=3) checkTrue( is.data.frame(compare(res, class=classes)) , "Result of method 'compare' (list with multiple runs + multiple methods) is a data.frame" ) } test.summary <- function(){ # create a random target matrix r <- 3; V <- .testData(r=r) # test on a single run checkTrue( is.numeric(summary(nmf(V, r))), 'Single run: result is numeric') # test on a multiple run (no keep) checkTrue( is.numeric(summary(nmf(V, r, nrun=3))), 'Multiple run (no keep): result is numeric') # test on a multiple run with keep checkTrue( is.numeric(summary(nmf(V, r, nrun=3, .options='k'))), 'Multiple run with keep: result is numeric') } test.parallel <- function(){ # create a random target matrix r <- 3; V <- .testData(r=r) # # run seeded standard sequential run ref <- nmf(V,r, nrun=3, .opt='k-p', seed=123456) # identical results with .pbackend='seq' and standard sequential res <- nmf(V,r, nrun=3, .opt='kP', seed=123456, .pbackend='seq') checkTrue( nmf.equal(res, ref), "Identical results with seeded parallel .pbackend='seq' and standard sequential '-p'" ) # identical results with .pbackend='par' and standard sequential res <- nmf(V,r, nrun=3, .opt='kP', seed=123456, .pbackend='par') checkTrue( nmf.equal(res, ref), "Identical results with seeded parallel .pbackend='par' and standard sequential '-p'" ) # identical results with .pbackend='mc' and standard sequential res <- nmf(V,r, nrun=3, .opt='kP', seed=123456, .pbackend='mc') checkTrue( nmf.equal(res, ref), "Identical results with seeded parallel .pbackend='mc' and standard sequential '-p'" ) # identical results with .pbackend='seq' and NA res <- nmf(V,r, nrun=3, .pbackend=NA, seed=123456) checkTrue( nmf.equal(res, ref), "Identical results with seeded .pbackend=NA and standard sequential" ) # identical results with .pbackend=cluster cl <- makeCluster(2) on.exit( stopCluster(cl), add=TRUE) res <- nmf(V,r, nrun=3, .pbackend=cl, seed=123456) checkTrue( nmf.equal(res, ref), "Identical results with seeded .pbackend=cl and standard sequential" ) # identical results with .pbackend=NULL and registered backend registerDoParallel(cl) on.exit( registerDoSEQ(), add=TRUE) res <- nmf(V,r, nrun=3, .pbackend=NULL, seed=123456) checkTrue( nmf.equal(res, ref), "Identical results with seeded .pbackend=NULL + registered backend and standard sequential" ) } #' Unit test for the stopping criterium test.nmf.stop <- function(){ # create a random target matrix r <- 3; V <- .testData(r=r) # if( is.null(maxIter <- nmf.getOption('maxIter')) ) maxIter <- 2000L maxIter <- maxIter + 100L checkIdentical( niter(nmf(V, r, .stop=37L)), 37L, "Integer stopping criterium: fixed number of iterations") checkIdentical( niter(nmf(V, r, .stop=maxIter)), maxIter , "Integer stopping criterium greater than default maxIter: fixed number of iterations is honoured") checkIdentical( niter(nmf(V, r, .stop=200L, maxIter=67L)), 67L , "Integer stopping criterium greater than provided maxIter: maxIter is honoured") checkTrue( niter(nmf(V, r, .stop=37)) != 37, "Numeric stopping criterium: stationarity threshold") checkTrue( niter(nmf(V, r, .stop='nmf.stop.stationary')) != 37, "stopping criterium 'stationary' as full name is passed correctly") checkTrue( niter(nmf(V, r, .stop='stationary')) != 37, "stopping criterium 'stationary' as short name is passed correctly") }NMF/inst/tests/runit.aheatmap.R0000644000176000001440000000072412234465004016107 0ustar ripleyusers# Unit tests for the heatmap drawing function # # Author: Renaud Gaujoux # Creation: 18 Nov 2011 ############################################################################### checkPlot <- function(...){ if( isCHECK() ) return() pkgmaker::checkPlot(...) } test.mfrow <- function(){ x <- rmatrix(20,10) checkPlot({ op <- par(mfrow=c(1,2)) on.exit(par(op)) aheatmap(x) aheatmap(x*100) }, "Using mfrow correctly generates two heatmaps side by side.") } NMF/inst/tests/runit.NMFSet.r0000644000176000001440000000752512234465004015471 0ustar ripleyusers# Unit testing for multiple NMF runs # # Author: Renaud Gaujoux ############################################################################### # make the internal functions visible if( isNamespaceLoaded('NMF') ){ join <- NMF:::NMFfitX } .testData <- function(n=20, r=3, m=10, ...){ syntheticNMF(n, r, m, ...) } check.result <- function(obj, V, r, size, msg=NULL){ checkTrue( is(obj, 'NMFfitX'), paste(msg, ' -> result is an object of class NMFfitX', sep='')) checkEquals( nrun(obj), size, paste(msg, ' -> number of run is correctly set', sep='')) } test.join.singleRuns <- function(){ # set random seed set.seed(123456) # create a random target matrix r <- 3; V <- .testData(r=r) # init a list for the results resL <- list() resL$brunet <- nmf(V, r) resL$brunet2 <- nmf(V, r) resL$brunet3 <- nmf(V, r) # simple join res <- join(resL) check.result(res, V, r, length(resL), 'Simple join') res <- join(resL, runtime.all={tt<-runif(5)}) check.result(res, V, r, length(resL), 'Simple join + set time') checkTrue(all.equal(tt, as.numeric(runtime.all(res))), 'Simple join + set time: time is correctly set') # merging join res <- join(resL, .merge=TRUE) check.result(res, V, r, length(resL), 'Merging join') } test.join.multipleRuns <- function(){ # set random seed set.seed(123456) # create a random target matrix r <- 3; V <- .testData(r=r) # init a list for the results resL <- list() nruns <- c(2,3,4) resL$brunet <- nmf(V, r, nrun=nruns[1]) resL$brunet2 <- nmf(V, r, nrun=nruns[2]) resL$brunet3 <- nmf(V, r, nrun=nruns[3]) res <- join(resL) check.result(res, V, r, sum(nruns), 'Join multiple runs') } test.join.multipleAndSingleRunsMethods <- function(){ # set random seed set.seed(123456) # create a random target matrix r <- 3; V <- .testData(r=r) # init a list for the results resL <- list() nruns <- c(1,3,4,1) resL$a <- nmf(V, r) resL$b <- nmf(V, r, nrun=nruns[2]) resL$c <- nmf(V, r, nrun=nruns[3]) resL$d <- nmf(V, r) res <- join(resL) check.result(res, V, r, sum(nruns), 'Join multiple runs + single runs') } test.multipleruns <- function(){ # set random seed set.seed(123456) # create a random target matrix r <- 3; V <- .testData(r=r) # multiple runs res <- nmf(V, r, nrun=5) check.result(res, V, r, 5, 'Multiple runs') } test.interface <- function(){ # set random seed set.seed(123456) # create a random target matrix r <- 3; V <- .testData(r=r) rownames(V) <- seq(nrow(V)) colnames(V) <- seq(ncol(V)) # perform multiple runs res <- nmf(V, r, nrun=5) # clusters checkTrue( is.factor(predict(res)), 'Clusters are computed without error') checkEquals( length(predict(res)), ncol(V), 'Clusters for samples have correct length') checkEquals( length(predict(res, 'features')), nrow(V), 'Clusters for features have correct length') checkTrue( is.list(predict(res, prob=TRUE)), 'Clusters are computed without error') # featureNames checkTrue( is.character(featureNames(res)), 'Feature names are accessible without error') # sampleNames checkTrue( is.character(sampleNames(res)), 'Sample names are accessible without error') } #' Unit test for the function 'fit' test.fit <- function(){ # set random seed set.seed(123456) # create a random target matrix n <- 20; r <- 3; m <- 30 V <- rmatrix(n,m) # check result check.result <- function(res){ cl <- class(res) checkTrue( is( fit(res), 'NMF' ), paste(cl, "- fit: returns an object of class 'NMF'")) checkTrue( !isNMFfit( fit(res) ), paste(cl, '- fit: does not return the complete fit')) checkTrue( is( minfit(res), 'NMFfit' ), paste(cl, "- minfit: returns a 'NMFfit' object")) } # perform multiple runs not keeping check.result( nmf(V, r) ) # perform multiple runs not keeping check.result( nmf(V, r, nrun=3, .opt='-k') ) # perform multiple runs keeping check.result( nmf(V, r, nrun=3, .opt='k') ) }NMF/inst/tests/runit.bioc.r0000644000176000001440000000230312234465004015276 0ustar ripleyusers# Unit tests for the Bioconductor layer # # Author: Renaud Gaujoux # Created: Mar 6, 2013 ############################################################################### # check extension of Bioc access methods # => this also serves to check that they are correctly exported test.access <- function(){ x <- nmfModel(3, 20, 10) .check <- function(fun, val, newval){ msg <- function(...) paste(fun, ': ', ..., sep='') f <- match.fun(fun) checkIdentical(f(x), val, msg('on fresh object returns NULL')) if( isNumber(newval) ) newval <- paste('aaa', 1:newval) res <- try(eval(parse(text=paste(fun, '(x) <- newval', sep='')))) checkTrue(!is(res, 'try-error'), msg('setting value works')) checkIdentical(f(x), newval, msg('new value is correct')) res <- try(eval(parse(text=paste(fun, '(x) <- val', sep='')))) checkTrue(!is(res, 'try-error'), msg('resetting value works')) checkIdentical(f(x), val, msg('reset value is correct')) } checkIdentical(nbasis(x), nmeta(x), 'nmeta is defined') .check('featureNames', NULL, 20) .check('sampleNames', NULL, 10) .check('basisnames', NULL, 3) .check('metaprofiles', coef(x), rmatrix(coef(x))) .check('metagenes', basis(x), rmatrix(basis(x))) }NMF/inst/tests/runit.NMFclass.r0000644000176000001440000011333212234470405016036 0ustar ripleyusers#' Unit Testing script for NMF package: NMF models and utilities. #' #' @author Renaud Gaujoux #' @creation 22 April 2009 # make the internal functions/objects visible if( isNamespaceLoaded('NMF') ){ .predict.nmf <- NMF:::.predict.nmf is.same <- NMF:::is.same } .TestSeed <- 123456 checkOnlyNAs <- function(x, msg){ checkTrue( all(is.na(basis(x))) , paste(msg, ': Only NAs in W')) checkTrue( all(is.na(coef(x))), paste(msg, ': Only NAs in H')) } basicHM <- aheatmap checkPlot <- function(...){ if( isCHECK() ) return() pkgmaker::checkPlot(...) } #' checks the validity of a NMF object: dimensions check.object <- function(obj, n, m, r, title='Check NMF object', class='NMFstd'){ # convert dimensions to integers n <- as.integer(n) m <- as.integer(m) r <- as.integer(r) # check class checkTrue(is(obj, class), paste(title, ': object is of class "', class, "'")); # check virtual interface accessors checkTrue(is.same(obj@W, basis(obj)), msg('method `basis` returns slot W')) checkTrue(is.same(obj@H, coef(obj)), msg('method `coef` returns slot H')) checkIdentical(nrow(basis(obj)), n, paste(title, ': number of rows in basis matrix is correct')) checkIdentical(nrow(obj), n, paste(title, ': nrow returns correct value')) checkIdentical(ncol(basis(obj)), r, paste(title, ': number of columns in basis matrix is correct')) checkIdentical(nbasis(obj), r, paste(title, ': nbasis returns correct value')) checkIdentical(nrow(coef(obj)), r, paste(title, ': number of rows in coef matrix correct')) checkIdentical(ncol(coef(obj)), m, paste(title, ': number of columns in coef matrix is correct')) checkIdentical(ncol(obj), m, paste(title, ': ncol returns correct value')) } check.NMF.class <- function(class, ...){ set.seed(.TestSeed) msg <- function(...) paste('New -', class,':', ...) # base constructor: should build an empty model a <- new(class, ...) # check if there is only NAs checkOnlyNAs(a, msg('with no parameters')) check.object(a, 0, 0, 0, msg('with no parameters'), class) # define some dimensions to use as template n <- 50; m <- 10; r <- 3; w <- rmatrix(n, r); h <- rmatrix(r, m) # base constructor with one of the two matrices: exceptions checkException(new(class, W=w, ...), msg('error if only basis matrix')) checkException(new(class, H=h, ...), msg('error if only coef matrix')) # base constructor with two matrices a <- new(class, W=w, H=h, ...) # check the dimensions of the internal matrices check.object(a, n, m, r, msg('with two matrices - '), class) checkIdentical(basis(a), w, msg('with two matrices - basis matrix is correctly set')); checkIdentical(coef(a), h, msg('with two matrices - coef matrix is correctly set')); # check error with wrong dimension checkException(a <- new(class, W=matrix(1,n,r+1), H=matrix(1,r,m), ...), msg('Error if incompatible dimensions (W)')) checkException(a <- new(class, W=matrix(1,n,r), H=matrix(1,r+1,m), ...), msg('Error if incompatible dimensions (H)')) } #' Tests the class 'NMF' test.class.NMFstd <- function(){ check.NMF.class('NMFstd') } #' Tests the class 'NMFns' test.class.NMFns <- function(){ # with no parameter check.NMF.class('NMFns') # with a parameter t <- 0.8 check.NMF.class('NMFns', theta=t) # test specific stuff a <- new('NMFns', theta=t) checkIdentical(a@theta, t, 'Slot theta is correctly set') checkException(a <- new('NMFns', theta=-1), 'Negative value of theta throws an exception') checkException(a <- new('NMFns', theta=1.2), 'Value of theta > 1 throws an exception') # test equivalence with standard model when theta=0 set.seed(.TestSeed) n <- 50; m <- 10; r <- 3 W <- rmatrix(n, r) H <- rmatrix(r, m) a.ns <- new('NMFns', W=W, H=H, theta=0) a.std <- new('NMFstd', W=W, H=H) checkIdentical(fitted(a.ns), fitted(a.std), 'Values fitted correspond to standard model if theta=0') # check method smoothing a.ns <- new('NMFns', W=W, H=H, theta=0.4) s <- smoothing(a.ns) checkEquals(dim(s), c(r, r), 'Smoothing matrix: dimension are correct') checkTrue( all(s >= 0), 'Smoothing matrix: all entries are nonnegative') checkEquals( rowSums(s), rep(1, r), 'Smoothing matrix: sum of rows are ones') checkEquals( colSums(s), rep(1, r), 'Smoothing matrix: sum of columns are ones') checkEquals( fitted(a.ns), basis(a.ns) %*% s %*% coef(a.ns), 'Fitted values are correct (product of basis, smoothing and coef).') #TODO: put this in file test.algorithms.R # n <- 100; m <- 20; r <- 3 # set.seed(.TestSeed) # V <- syntheticNMF(n, r, m, noise=TRUE) # add noise for stability # set.seed(.TestSeed) # res.std <- fit(nmf(V, r, 'brunet', seed='nndsvd')) # set.seed(.TestSeed) # res.ns <- fit(nmf(V, r, 'ns', seed='nndsvd', theta=0)) #checkEqualsNumeric(basis(res.ns), basis(res.std), 'W from nsNMF(theta=0) are the same as the ones from the standard model') #checkEqualsNumeric(coef(res.ns), coef(res.std), 'H from nsNMF(theta=0) are the same as the ones from the standard model') } test.nmfModel <- function(){ set.seed(.TestSeed) # define some dimensions to use as template n <- as.integer(25); m <- as.integer(10); r <- as.integer(3); check.empty.model <- function(x, n, m, r, msg, class='NMFstd'){ check.object(x, n, m, r, msg, class) checkOnlyNAs(x, msg) } # check basic errors checkException(nmfModel(numeric()), 'Error if negative rank') checkException(nmfModel(c(1,2)), 'Error if rank of length != 1') checkException(nmfModel(r, -1), 'Error if negative target dimension') checkException(nmfModel(r, 1:3), 'Error if target dimension of length > 2') checkException(nmfModel(r, 1, -1), 'Error if target ncol negative') checkException(nmfModel(r, 1, 1:2), 'Error if target ncol of length > 1') checkException(nmfModel(r, 1, matrix(1,2,2)), 'Error if target ncol not vector') # constructor of empty model check.empty.model(nmfModel(), 0, 0, 0, 'Constructor with no arguments returns empty model') # constructor of empty model with ncol specified check.empty.model(nmfModel(ncol=5), 0, 5, 0, 'Constructor with only with ncol specified') # constructor with missing target check.empty.model(nmfModel(r), 0, 0, r, 'Constructor with missing target') # constructor using dimension vector check.empty.model(nmfModel(r, c(n,m)), n, m, r, 'Constructor with dimensions as a vector') # constructor using separate dimensions check.empty.model(nmfModel(r, n, m), n, m, r, 'Constructor with separate dimensions') # constructor with single dimension check.empty.model(nmfModel(r, n), n, n, r, 'Constructor with single dimension (nrow)') # constructor with single dimension (ncol) check.empty.model(nmfModel(r, ncol=m), 0, m, r, 'Constructor with single dimension (ncol)') #TODO: check exceptions if passing negative numbers # constructor using a target matrix msg <- function(...) paste('Constructor with target matrix -', ...) V <- rmatrix(n, m) check.empty.model(nmfModel(r, V), n, m, r, msg('second argument')) check.empty.model(nmfModel(V, r), n, m, r, msg('first argument')) check.empty.model(nmfModel(V), n, m, 0, msg('single argument')) dimnames(V) <- list(rows=letters[1:n], cols=letters[1:m]) checkIdentical(dimnames(nmfModel(V)), c(dimnames(V), list(NULL)), msg('dimnames are correctly set')) checkIdentical(dimnames(nmfModel(V, use.names=FALSE)), NULL, msg('dimnames are not used if use.names=FALSE')) w <- rmatrix(n, r); h <- rmatrix(r, m) # constructor supplying matrices W and H msg <- function(...) paste('Constructor with target rank and both basis and coef matrices -', ...) a <- nmfModel(r, W=w, H=h) check.object(a, n, m, r, msg()) checkIdentical(basis(a), w, msg('basis matrix is correctly set')) checkIdentical(coef(a), h, msg('coef matrix is correctly set')) checkException(nmfModel(r, c(n+1,m), W=w, H=h), msg('error if bad number of rows in basis matrix')) checkException(nmfModel(r, c(n,m), W=w[,-r], H=h), msg('error if bad number of columns in basis matrix')) checkException(nmfModel(r, c(n,m), W=w, H=h[-r,]), msg('error if bad number of rows in coef matrix')) checkException(nmfModel(r, c(n,m+1), W=w, H=h), msg('error if bad number of columns in coef matrix')) # reducing dimensions rmsg <- function(...) msg('reduce rank -', ...) a <- nmfModel(r-1, W=w, H=h) check.object(a, n, m, r-1, rmsg('dimensions are OK')) checkIdentical(basis(a), w[,-r], rmsg("entries for basis are OK")) checkIdentical(coef(a), h[-r,], rmsg("entries for coef are OK")) rmsg <- function(...) msg('reduce nrow -', ...) a <- nmfModel(r, n-1, W=w, H=h) check.object(a, n-1, m, r, rmsg('dimensions are OK')) checkIdentical(basis(a), w[-n,], rmsg("entries for basis are OK")) checkIdentical(coef(a), h, rmsg("entries for coef are OK")) rmsg <- function(...) msg('reduce ncol -', ...) a <- nmfModel(r, ncol=m-1, W=w, H=h) check.object(a, n, m-1, r, rmsg('dimensions are OK')) checkIdentical(basis(a), w, rmsg("entries for basis are OK")) checkIdentical(coef(a), h[,-m], rmsg("entries for coef are OK")) # constructor supplying only matrices W and H msg <- function(...) paste('Constructor with only basis and coef matrices (named arguments) -', ...) a <- nmfModel(W=w, H=h) check.object(a, n, m, r, msg()) checkIdentical(basis(a), w, msg('basis matrix is correctly set')) checkIdentical(coef(a), h, msg('coef matrix is correctly set')) checkException(nmfModel(W=matrix(1, n, r+1), H=matrix(1, r, m)), msg('error if incompatible dimensions (1)')) checkException(nmfModel(W=matrix(1, n, r), H=matrix(1, r+1, m)), msg('error if incompatible dimensions (2)')) # constructor supplying only matrices W and H and not naming the arguments msg <- function(...) paste('Constructor with only basis and coef matrices (unamed argument) -', ...) a <- nmfModel(w, h) check.object(a, n, m, r, msg()) checkIdentical(basis(a), w, msg('basis matrix is correctly set')) checkIdentical(coef(a), h, msg('coef matrix is correctly set')) checkException(nmfModel(matrix(1, n, r+1), matrix(1, r, m)), msg('error if incompatible dimensions (1)')) checkException(nmfModel(matrix(1, n, r), matrix(1, r+1, m)), msg('error if incompatible dimensions (2)')) # constructor supplying only W and target rank msg <- function(...) paste('Constructor with target rank and basis matrix only -', ...) a <- nmfModel(r, W=w) check.object(a, n, 0, r, msg()) checkIdentical(basis(a), w, msg('basis matrix is correctly set')) checkTrue(all(is.na(coef(a))), msg('only NA in coef matrix')) checkException(nmfModel(r+1, W=w), msg('error if smaller number of columns in basis matrix')) # reducing dimensions rmsg <- function(...) msg('reduce rank -', ...) a <- nmfModel(r-1, W=w) check.object(a, n, 0, r-1, rmsg('dimensions are OK')) checkIdentical(basis(a), w[,-r], rmsg("entries for basis are OK")) checkTrue(all(is.na(coef(a))), rmsg('only NA in coef matrix')) checkException(nmfModel(r-1, W=w, force.dim=FALSE), msg('error if greater number of columns in basis matrix and force.dim=FALSE')) # constructor supplying only W msg <- function(...) paste('Constructor with basis matrix only -', ...) a <- nmfModel(W=w) check.object(a, n, 0, r, msg()) checkIdentical(basis(a), w, msg('basis matrix is correctly set')) checkTrue(all(is.na(coef(a))), msg('only NA in coef matrix')) # constructor supplying only H and target rank msg <- function(...) paste('Constructor with target rank and coef matrix only -', ...) a <- nmfModel(r, H=h) check.object(a, 0, m, r, msg()) checkIdentical(coef(a), h, msg('coef matrix is correctly set')) checkTrue(all(is.na(basis(a))), msg('only NA in basis matrix')) checkException(nmfModel(r+1, H=h), msg('error if smaller number of rows in coef matrix')) # reducing dimensions rmsg <- function(...) msg('reduce rank -', ...) a <- nmfModel(r-1, H=h) check.object(a, 0, m, r-1, rmsg('dimensions are OK')) checkIdentical(coef(a), h[-r,], rmsg('coef matrix is correctly set')) checkTrue(all(is.na(basis(a))), rmsg('only NA in basis matrix')) checkException(nmfModel(r-1, H=h, force.dim=FALSE), msg('error if greater number of rows in coef matrix and force.dim=FALSE')) # constructor supplying only H msg <- function(...) paste('Constructor with coef matrix only -', ...) a <- nmfModel(H=h) check.object(a, 0, m, r, msg()) checkIdentical(coef(a), h, msg('coef matrix is correctly set')) checkTrue(all(is.na(basis(a))), msg('only NA in basis matrix')) # constructor supplying W and target dimensions msg <- function(...) paste('Constructor with basis matrix and both target dimensions -', ...) a <- nmfModel(r, n, m, W=w) check.object(a, n, m, r, msg()) checkIdentical(basis(a), w, rmsg("entries for basis are OK")) checkTrue(all(is.na(coef(a))), rmsg('only NA in coef matrix')) rmsg <- function(...) msg('reduce nrow -', ...) a <- nmfModel(r, n-1, m, W=w) check.object(a, n-1, m, r, rmsg('dimensions are OK')) checkIdentical(basis(a), w[-n,], rmsg("entries for basis are OK")) checkTrue(all(is.na(coef(a))), rmsg('only NA in coef matrix')) checkException(nmfModel(r, n+1, m, W=w), msg('error if smaller number of rows in basis matrix')) checkException(nmfModel(r, n-1, W=w, force.dim=FALSE), msg('error if greater number of rows in basis matrix and force.dim=FALSE')) checkException(nmfModel(r+1, n, m, W=w), msg('error if smaller number of columns in basis matrix')) # constructor supplying H and target dimensions msg <- function(...) paste('Constructor with coef matrix and both target dimensions -', ...) a <- nmfModel(r, n, m, H=h) check.object(a, n, m, r, msg()) checkTrue(all(is.na(basis(a))), msg('only NA in basis matrix')) checkIdentical(coef(a), h, msg('coef matrix is correctly set')) rmsg <- function(...) msg('reduce ncol -', ...) a <- nmfModel(r, n , m-1, H=h) check.object(a, n, m-1, r, rmsg('dimensions are OK')) checkIdentical(coef(a), h[,-m], rmsg('coef matrix is correctly set')) checkTrue(all(is.na(basis(a))), rmsg('only NA in basis matrix')) checkException(nmfModel(r+1, n, m, H=h), msg('error if smaller number of rows in coef matrix')) checkException(nmfModel(r, n, m-1, H=h, force.dim=FALSE), msg('error if greater number of columns in coef matrix and force.dim=FALSE')) checkException(nmfModel(r, n, m+1, H=h), msg('error if smaller number of columns in coef matrix')) # check basisnames passage check.model.dimnames <- function(x, dn, title){ msg <- function(...) paste(title, '-', ...) checkIdentical(dimnames(x), dn, msg("dimnames are correct")) checkIdentical(colnames(basis(x)), dn[[3]], msg("colnames of basis matrix are correct")) checkIdentical(rownames(coef(x)), dn[[3]], msg("rownames of coef matrix are correct")) } dn <- letters[1:nrow(h)] h2 <- h; rownames(h2) <- dn; a <- nmfModel(r, H=h2) check.model.dimnames(a, list(NULL, NULL, dn), "Basis names are passed from input coef matrix") w2 <- w; colnames(w2) <- dn; a <- nmfModel(r, W=w2) check.model.dimnames(a, list(NULL, NULL, dn), "Basis names are passed from input basis matrix") w2 <- w; colnames(w2) <- dn; h2 <- h; rownames(h2) <- dn; a <- nmfModel(W=w2, H=h2) check.model.dimnames(a, list(NULL, NULL, dn), "Basis names are used unchanged if equal in input basis and coef matrices") msg <- function(...) paste("Basis names from input basis matrix are used to order the components - ", ...) w2 <- w; colnames(w2) <- dn; h2 <- h; rownames(h2) <- rev(dn); a <- nmfModel(W=w2, H=h2) check.model.dimnames(a, list(NULL, NULL, dn), msg("rownames of input basis are enforced")) checkIdentical(basis(a), w2, msg("basis unchanged")) checkIdentical(coef(a), h2[nrow(h):1,], msg("coef entries are reordered")) msg <- function(...) paste("Basis names from input basis matrix are NOT used to order the components if argument order.basis=FALSE - ", ...) w2 <- w; colnames(w2) <- dn; h2 <- h; rownames(h2) <- rev(dn); a <- nmfModel(W=w2, H=h2, order.basis=FALSE) check.model.dimnames(a, list(NULL, NULL, dn), msg("rownames of input basis are enforced")) checkIdentical(basis(a), w2, msg("basis unchanged")) checkEquals(coef(a), h2, msg("coef entries are not ordered"), check.attributes=FALSE) msg <- function(...) paste("Basis names from input basis matrix are forced onto to the coef matrix - ", ...) w2 <- w; colnames(w2) <- dn; h2 <- h; rownames(h2) <- paste(letters[1:nrow(h)], 2); a <- nmfModel(W=w2, H=h2) check.model.dimnames(a, list(NULL, NULL, dn), msg("rownames of input basis are enforced")) checkIdentical(basis(a), w2, msg("basis is unchanged")) checkEquals(coef(a), h2, msg("coef entries are correct"), check.attributes=FALSE) } test.dimensions <- function(){ # define some dimensions to use as template n <- as.integer(50); m <- as.integer(10); r <- as.integer(3); # create an NMF object a <- nmfModel(r, n, m) # check the dimensions checkIdentical(dim(a), c(n, m, r), "Function 'dim' is OK") # check the row number checkIdentical(nrow(a), n, "Function 'nrow' is OK") # check the column number checkIdentical(ncol(a), m, "Function 'ncol' is OK") # check the number of basis checkIdentical(nbasis(a), r, "Function 'nbasis' is OK") } check.dimnames <- function(x, dn, msg){ checkIdentical(dimnames(x), dn, paste(msg, '-',"dimnames returns correct value")) checkIdentical(dimnames(x)[c(1,3)], dimnames(basis(x)), paste(msg, '-', "dimnames returns value consistent with basis")) checkIdentical(dimnames(x)[c(3,2)], dimnames(coef(x)), paste(msg, '-', "dimnames returns value consistent with coef")) checkIdentical(rownames(x), dn[[1]], paste(msg, '-', "rownames returns correct value")) checkIdentical(rownames(basis(x)), rownames(x), paste(msg, '-', "rownames returns same value as rownames(basis)")) checkIdentical(colnames(x), dn[[2]], paste(msg, '-', "colnames returns correct value")) checkIdentical(colnames(coef(x)), colnames(x), paste(msg, '-', "colnames returns same value as colnames(basis)")) checkIdentical(basisnames(x), dn[[3]], paste(msg, '-', "basisnames returns correct value")) checkIdentical(colnames(basis(x)), basisnames(x), paste(msg, '-', "basisnames returns same value as colnames(basis)")) checkIdentical(rownames(coef(x)), basisnames(x), paste(msg, '-', "basisnames returns same value as rownames(coef)")) } test.dimnames <- function(){ # set random seed set.seed(.TestSeed) # define some dimensions to use as template n <- 20; m <- 10; r <- 3; # generate matrices w <- rmatrix(n, r); h <- rmatrix(r, m) M <- nmfModel(r, n, m) # check errors a <- M checkException({dimnames(a) <- 1:n}, 'set to vector') checkException({dimnames(a) <- list(seq(n-1))}, 'Error of wrong dimension (nrow-1)') checkException({dimnames(a) <- list(seq(n+1))}, 'Error of wrong dimension (nrow+1)') # check with no elements msg <- function(...) paste('Dimnames with 2 elements -', ...) a <- M check.dimnames(a, NULL, 'No dimnames => NULL') check.dimnames({dimnames(a) <- NULL; a}, NULL, msg('set to NULL')) check.dimnames({dimnames(a) <- list(); a}, NULL, msg('set to list()')) # check with one elements msg <- function(...) paste('Dimnames with 1 element -', ...) a <- M dn <- list(letters[1:nrow(a)]) dn.name <- setNames(dn, 'rows') check.dimnames({a <- M; dimnames(a) <- dn; a}, c(dn, list(NULL, NULL)), msg('Set dimnames')) check.dimnames({a <- M; dimnames(a) <- dn.name; a}, c(dn.name, list(NULL, NULL)), msg('Set with names')) check.dimnames({a <- M; rownames(a) <- dn[[1]]; a}, c(dn, list(NULL, NULL)), msg('Set rownames')) check.dimnames({a <- M; colnames(a) <- letters[1:ncol(a)]; a}, list(NULL, letters[1:ncol(a)], NULL), msg('Set colnames')) check.dimnames({a <- M; basisnames(a) <- letters[1:nbasis(a)]; a}, list(NULL, NULL, letters[1:nbasis(a)]), msg('Set basisnames')) check.dimnames({dimnames(a) <- NULL; a}, NULL, msg('Reset to NULL')) # check with two elements msg <- function(...) paste('Dimnames with 2 elements -', ...) a <- M dn <- list(letters[1:nrow(a)], letters[seq(nrow(a)+1, nrow(a)+ncol(a))]) dn.name <- setNames(dn, c('rows', 'cols')) check.dimnames({dimnames(a) <- dn; a}, c(dn, list(NULL)), msg('Set dimnames')) check.dimnames({dimnames(a) <- NULL; a}, NULL, msg('Reset to NULL')) check.dimnames({dimnames(a) <- dn.name; a}, c(dn.name, list(NULL)), msg('Set with names')) check.dimnames({dimnames(a) <- NULL; a}, NULL, msg('Reset to NULL (2)')) # check with three elements msg <- function(...) paste('Dimnames with 3 elements -', ...) a <- M dn <- list(letters[1:nrow(a)], letters[seq(nrow(a)+1, nrow(a)+ncol(a))], letters[seq(nrow(a)+ncol(a)+1, nrow(a)+ncol(a)+nbasis(a))]) dn.name <- setNames(dn, c('rows', 'cols', 'basis')) check.dimnames({dimnames(a) <- dn; a}, dn, msg('Set dimnames')) check.dimnames({dimnames(a) <- NULL; a}, NULL, msg('Reset to NULL')) check.dimnames({dimnames(a) <- dn.name; a}, dn.name, msg('Set with names')) check.dimnames({dimnames(a) <- NULL; a}, NULL, msg('Reset to NULL (2)')) } #' Unit test for accessor method: \code{basis} test.basis <- function(){ # define some dimensions to use as template n <- 50; m <- 10; r <- 3; # create an empty object a <- nmfModel(r); # get factor W checkTrue(is.same(basis(a), a@W), "Method 'basis' correctly returns slot W"); # set factor W W.ext <- matrix(1, n, r) basis(a) <- W.ext checkIdentical(a@W, W.ext, "Method 'basis<-' correctly sets slot W"); #checkException(basis(a) <- matrix(1, n, r+1), "Error if setting basis with a matrix of incompatible dimensions"); } #' Unit test for accessor method: \code{coef} test.coef <- function(){ # define some dimensions to use as template n <- 50; m <- 10; r <- 3; # create an empty object a <- nmfModel(r); # get factor H checkTrue(is.same(coef(a), a@H), "Method 'coef' correctly returns slot H"); # set factor H ext <- matrix(1, r, m) coef(a) <- ext checkIdentical(a@H, ext, "Method 'coef<-' correctly sets slot H"); #checkException(coef(a) <- matrix(1, r+1, m), "Error if setting coef with a matrix of incompatible dimensions"); } test.NMF.rnmf <- function(){ # define some dimensions to use as template n <- 50; m <- 10; r <- 3; # create an empty NMF object a <- nmfModel(r) # check parameter validity checks set.seed(.TestSeed) checkException(rnmf(a, as.numeric(NA)), 'Error thrown if single NA value') checkException(rnmf(a, as.numeric(c(1,NA))), 'Error thrown if some NA value') checkException(rnmf(a, c(1,2,3)), 'Error thrown if some length greater than 2') checkException(rnmf(a, numeric()), 'Error thrown if some length is 0') # create a random NMF of given dimension set.seed(.TestSeed) a <- rnmf(r, n, m) checkPlot(basicHM(basis(a)), 'Random NMF basis (target dimension)') checkPlot(basicHM(coef(a)), 'Random NMF coef (target dimension)') # check the NMF dimensions checkEquals(nrow(a), n, 'number of rows matches target dimension') checkEquals(ncol(a), m, 'number of columns matches target dimension') checkEquals(nbasis(a), r, 'number of basis matches target dimension') # check equivalence of calls set.seed(.TestSeed) checkIdentical(a, rnmf(r, c(n, m)), "calling with numeric target of length 2 is equivalent to separate dimensions") set.seed(.TestSeed) checkIdentical(a, rnmf(r, n, m), "calling with numeric target of length 2 is equivalent to separate dimensions") # create a random NMF based on a template NMF a <- nmfModel(r, n, m) set.seed(.TestSeed) b <- rnmf(a) checkPlot(basicHM(basis(b)), 'Random NMF basis (target NMF)') checkPlot(basicHM(coef(b)), 'Random NMF coef (target NMF)') # check the NMF dimensions checkEquals(nrow(a), nrow(b), 'number of rows matches NMF target') checkEquals(ncol(a), ncol(b), 'number of columns matches NMF target') checkEquals(nbasis(a), nbasis(b), 'number of basis matches NMF model') # create a random NMF based on a target ExpressionSet set.seed(.TestSeed) max.entry <- 100 V <- new('ExpressionSet', exprs=rmatrix(n, m, min=0, max=max.entry)) a <- nmfModel(r, n, m) check.object(a <- rnmf(a, V), n, m, r, 'NMFobject + target ExpressionSet') check.dimnames(a, c(dimnames(exprs(V)), list(NULL)), 'NMFobject + target ExpressionSet') check.object(a <- rnmf(r, V), n, m, r, 'rank + target ExpressionSet') check.dimnames(a, c(dimnames(exprs(V)), list(NULL)), 'rank + target ExpressionSet') # create a random NMF based on a target matrix set.seed(.TestSeed) max.entry <- 100 V <- rmatrix(n, m, min=0, max=max.entry) a <- nmfModel(r, n, m) a <- rnmf(a, V) checkPlot(basicHM(basis(a)), 'Random NMF basis (target matrix)') checkPlot(basicHM(coef(a)), 'Random NMF coef (target matrix)') # check the NMF dimensions checkEquals(nrow(a), n, 'number of rows matches matrix target') checkEquals(ncol(a), m, 'number of columns matches matrix target') checkEquals(nbasis(a), r, 'matrix target: number of basis matches NMF model') # check maximum value msg <- function(...) paste('Set max in target matrix -', ...) .check_max <- function(x, max.entry){ checkTrue( max(basis(a)) <= max.entry, msg("Basis maximum entry is OK (<=)")) checkTrue( max(basis(a)) >= max.entry/2, msg("Basis maximum entry is OK (>=)")) checkTrue( max(coef(a)) <= max.entry, msg("Coef maximum entry is OK (<=)")) checkTrue( max(coef(a)) >= max.entry/2, msg("Coef maximum entry is OK (>=)")) } .check_max(a, max.entry) # check dimnames dn <- list(rows=letters[1:nrow(V)], cols=letters[seq(25-ncol(V)+1,25)]) dimnames(V) <- dn check.dimnames(rnmf(a, V), c(dn, list(NULL)), "rnmf on target matrix with dimnames: dimnames are passed") check.dimnames(rnmf(a, V, use.dimnames=FALSE), NULL, "rnmf on target matrix with dimnames and use.dimnames=FALSE: dimnames are not passed") # setting maximum on NMFOffset model msg <- function(...) paste('Set max by argument -', ...) set.seed(.TestSeed) a <- rnmf(r, V, model='NMFOffset') .check_max(a, max.entry) # setting maximum entry by argument msg <- function(...) paste('Set max by argument -', ...) set.seed(.TestSeed) max.entry <- 5 a <- rnmf(r, n, m, dist=list(max=max.entry)) .check_max(a, max.entry) } #' Tests synthetic data generation test.syntheticNMF <- function(){ # define sizes n <- 100; m <- 20; r <- 3 # standard set.seed(.TestSeed) d <- syntheticNMF(n, r, m) checkPlot(basicHM(d), 'Synthetic data plain') # with offset set.seed(.TestSeed) n.offset <- 15 o <- c(rep(1, n.offset), rep(0, n-n.offset)) d <- syntheticNMF(n, r, m, offset=o) # the function should throw an error when called with an offset of wrong length checkException(syntheticNMF(n, r, m, offset=o[-1])) checkPlot(basicHM(d), 'Synthetic data offset') # with noise set.seed(.TestSeed) d <- syntheticNMF(n, r, m, noise=TRUE) checkPlot(basicHM(d), 'Synthetic data with noise') # with offset and noise set.seed(.TestSeed) d <- syntheticNMF(n, r, m, offset=o, noise=TRUE) checkPlot(basicHM(d), 'Synthetic data with offset and noise') } # Sparseness test.sparseness <- function(){ # local function to check bounds of sparseness checkBounds <- function(s){ checkTrue(s >= 0, 'greater than 0') checkTrue(s <= 1, 'lower than 1') } # test with a perfectly non-sparse vector (constant vector) x <- rep(1, 100) s <- sparseness(x) # check values checkBounds(s) checkEqualsNumeric(s, 0, 'should be 0') # test with a perfectly sparse vector x <- c(1, rep(0, 100)) s <- sparseness(x) # check values checkBounds(s) checkEqualsNumeric(s, 1) # define sizes n <- 100; m <- 20; r <- 3 # test with a random matrix (not necessarly positive) set.seed(.TestSeed) V <- matrix(rnorm(n*m), n, m) s <- sparseness(V) #check values checkBounds(s) # test with a random NMF object a <- nmfModel(r, V) set.seed(.TestSeed) a <- rnmf(a, V) s <- sparseness(a) # check return vector checkTrue( length(s) == 2, "Method 'sparseness' returns a 2-length vector" ) #check values checkBounds(s[1]) checkBounds(s[2]) } # Clusters test.predict <- function(){ # define some dimensions n <- 100; m <- 20; r <- 3 .msg <- NULL mess <- function(...) paste(.msg, ':', ...) # test on a known matrix .msg <- 'Artificial matrix' V <- matrix(c( c(1, rep(0,n-1)), c(0, 1, rep(0,n-2)), rep(c(0,0,1, rep(0, n-3)), m-2) ) , n, m) # compute clusters res <- .predict.nmf(t(V)) # check the result checkEquals(res, as.factor(c(1, 2, rep(3, m-2))), mess('Return known clusters')) # test on a random matrix .msg <- 'Random matrix' set.seed(.TestSeed) V <- matrix(sapply(sample(n), function(i){x <- rep(0, n); x[i] <- 1; x}), n, m) # compute clusters res <- .predict.nmf(V) # check the result checkTrue( is.factor(res), mess('Result is a factor')) checkTrue( length(res) == nrow(V), mess('Result is the right size' )) checkTrue( nlevels(res) == ncol(V), mess('Result has the right number of levels' )) # test on a random NMF .msg <- 'NMF model' a <- nmfModel(r, V) set.seed(.TestSeed) a <- rnmf(a) res <- predict(a, 'samples') # check the result checkTrue( is.factor(res), mess('Result is a factor')) checkTrue( length(res) == ncol(a), mess('Result has right size' )) checkTrue( nlevels(res) == nbasis(a), mess('Result has right number of levels' )) # factor .msg <- 'Factor' res <- predict(a, 'features') # check the result checkTrue( is.factor(res), mess('Result is a factor')) checkTrue( length(res) == nrow(a), mess('Result has right size' )) checkTrue( nlevels(res) == nbasis(a), mess('Result has right number of levels' )) } # Purity test.purity <- function(){ # local function to check bounds of purity checkBounds <- function(x){ checkTrue(x >= 0, 'greater than 0') checkTrue(x <= 1, 'lower than 1') } # generate factor x <- as.factor(c(rep(1,5), rep(2,10), rep(3,15))) # compute perfect clustering p <- purity(x, x) checkBounds(p) checkEqualsNumeric(p, 1) # compute random clustering set.seed(.TestSeed) p <- purity(as.factor(sample(x)), x) checkBounds(p) } # Entropy test.entropy <- function(){ # local function to check bounds of entropy checkBounds <- function(x){ checkTrue(x >= 0, 'greater than 0') checkTrue(x <= 1, 'lower than 1') } # generate factor x <- as.factor(c(rep(1,5), rep(2,10), rep(3,15))) # comppute perfect entropy e <- entropy(x, x) checkBounds(e) checkEqualsNumeric(e, 0) # compute random clustering set.seed(.TestSeed) e <- entropy(as.factor(sample(x)), x) checkBounds(e) } #' Tests the distance method test.deviance <- function(){ # define some dimensions and matrices n <- 10; m <- 5; set.seed(.TestSeed) y <- rmatrix(n, m) # random matrix 1 x <- rnmf(nmfModel(3, y)) # check default is no computation checkEquals( deviance(x, y), as.numeric(NA), 'With no method: NA') # check error if undefined method checkException( deviance(x, y, 'toto'), 'Error if undefined method') # check if works when passing a function name norm1 <- function(x, y){ sum(abs(fitted(x)-y)) } # local function # generate a random function name funname <- paste('test', paste(sample(1:9, 20, replace=TRUE), collapse=''), sep='.') assign(funname, norm1, envir=.GlobalEnv) on.exit(rm(list=funname, envir=.GlobalEnv), add=TRUE) #TODO: make it work without assigning in .GloablEnv checkTrue( deviance(x, y, norm1) > 0, 'Works with a user-defined function in .GlobalEnv') checkTrue( deviance(x, y, funname) > 0, 'Works with name of a user-defined function .GlobalEnv') # check euclidean distance meth <- 'euclidean' #checkEqualsNumeric( deviance(x, x, meth), 0, 'Euclidean: separation') checkTrue( deviance(x, y, meth) > 0, 'Euclidean: positive') checkEqualsNumeric( deviance(x, y, meth), sum((fitted(x) - y)^2)/2, 'Euclidean: OK') # check Kullback-Leibler divergence meth <- 'KL' #checkEqualsNumeric( deviance(x, x, meth), 0, 'KL: separation') checkTrue( deviance(x, y, meth) > 0, 'KL: positive') #checkTrue( deviance(x, y, meth) != deviance(y, x, meth), 'KL: not symetric') # check if not infinite when there is some zero entries in the target matrix z <- y; z[1,] <- 0 checkTrue( deviance(x, z, meth) != Inf, 'Ok if some zeros in the target' ) # check if infinite when there is some zero entries in the second term z <- x; basis(z)[1,] <- 0 checkIdentical( deviance(z, y, meth), Inf, 'Infinite if some zeros in the estimate' ) } #' Tests the connectivity method test.connectivity <- function(){ # define some dimensions to use as template n <- 50; m <- 10; r <- 3; # build random NMF set.seed(.TestSeed) a <- nmfModel(r, c(n,m)) a <- rnmf(a) con <- connectivity(a) # check properties of the connectivity matrix checkTrue( is.matrix(con), 'The result is a matrix') checkTrue( all(con %in% c(0,1)), 'All entries are 0 or 1') checkTrue( all(t(con) == con) , 'The connectivity matrix is symmetric') } #' test subsetting function test.subset <- function(){ # create a random NMF object n <- 30; r <- 5; p <- 20 a <- nmfModel(r, n, p) a <- rnmf(a) # fake subset checkTrue(identical(a[], a), "subset [] is OK (identical)") checkTrue(identical(a[,], a), "subset [,] is OK (identical)") checkTrue(identical(a[TRUE,], a), "subset [TRUE,] is OK (identical)") checkTrue(identical(a[,TRUE], a), "subset [,TRUE] is OK (identical)") checkTrue(identical(a[TRUE,TRUE], a), "subset [TRUE,TRUE] is OK (identical)") checkTrue(identical(a[,,TRUE], a), "subset [,,TRUE] is OK (identical)") checkTrue(identical(a[TRUE,TRUE,TRUE], a), "subset [TRUE,TRUE,TRUE] is OK (identical)") # with NULL checkTrue(identical(a[NULL,], a[0,]), "subset [NULL,] is OK") checkTrue(identical(a[,NULL], a[,0]), "subset [,NULL] is OK") checkTrue(identical(a[NULL,NULL], a[0,0]), "subset [NULL,NULL] is OK") checkTrue(identical(a[NULL,NULL,NULL], a[0,0,0]), "subset [NULL,NULL,NULL] is OK") checkException(a[,,], "Error when called with [,,]") # subset on features checkEquals(dim(a[1,]), c(1, p, r), "subset 1 feature is OK (dim)") checkEquals(basis(a[5,]), basis(a)[5,, drop=FALSE], "subset 1 feature is OK (basis)") checkEquals(coef(a[5,]), coef(a), "subset 1 feature is OK (coef)") checkEquals(a[5,,drop=TRUE], basis(a)[5,, drop=TRUE], "subset 1 feature dropping is OK (return basis)") checkEquals(dim(a[1:10,]), c(10, p, r), "subset more than 1 feature is OK (dim)") checkEquals(basis(a[1:10,]), basis(a)[1:10,, drop=FALSE], "subset more than 1 feature is OK (basis)") checkEquals(coef(a[1:10,]), coef(a), "subset more than 1 feature is OK (coef)") checkEquals(a[1:10,,drop=TRUE], basis(a)[1:10,, drop=TRUE], "subset more than 1 feature dropping is OK (return basis)") # subset on samples checkEquals(dim(a[,1]), c(n, 1, r), "subset 1 sample is OK (dim)") checkEquals(coef(a[,5]), coef(a)[,5, drop=FALSE], "subset 1 sample is OK (coef)") checkEquals(basis(a[,1]), basis(a), "subset 1 sample is OK (basis)") checkEquals(a[,5,drop=TRUE], coef(a)[,5, drop=TRUE], "subset 1 sample dropping is OK (return coef)") checkEquals(dim(a[,1:10]), c(n, 10, r), "subset more then 1 sample is OK (dim)") checkEquals(coef(a[,1:10]), coef(a)[,1:10, drop=FALSE], "subset more than 1 sample is OK (coef)") checkEquals(basis(a[,1:10]), basis(a), "subset more than 1 sample is OK (basis)") checkEquals(a[,1:10,drop=TRUE], coef(a)[,1:10, drop=TRUE], "subset more than 1 sample dropping is OK (return coef)") # subset on basis checkEquals(dim(a[,,1]), c(n, p, 1), "subset 1 basis is OK (dim)") checkEquals(coef(a[,,3]), coef(a)[3,, drop=FALSE], "subset 1 basis is OK (coef)") checkEquals(basis(a[,,3]), basis(a)[,3, drop=FALSE], "subset 1 basis is OK (basis)") checkTrue(identical(a[,,3,drop=TRUE], a[,,3,drop=TRUE]), "subset 1 basis dropping is OK (do nothing)") checkEquals(dim(a[,,2:4]), c(n, p, 3), "subset more than 1 basis is OK (dim)") checkEquals(coef(a[,,2:4]), coef(a)[2:4, , drop=FALSE], "subset more than 1 basis is OK (coef)") checkEquals(basis(a[,,2:4]), basis(a)[, 2:4, drop=FALSE], "subset more than 1 basis is OK (basis)") checkTrue(identical(a[,,2:4,drop=TRUE], a[,,2:4,drop=FALSE]), "subset more than 1 basis dropping is OK (do nothing)") checkEquals(dim(a[NULL]), c(n, p, 0), "subset basis NULL is OK (dim)") checkIdentical(a[2], basis(a)[,2], "subset with single index + drop missing returns single basis as vector") checkIdentical(a[2, drop = FALSE], a[,,2], "subset with single index with drop=FALSE returns the complete NMF object") checkIdentical(a[2, drop=TRUE], basis(a)[,2, drop=TRUE], "subset with single index + drop=TRUE returns single basis as vector") checkTrue(is.nmf(a[2:3]), "subset with single vector index returns NMF object") checkEquals(basis(a[2:3]), basis(a)[,2:3], "subset with single vector index returns subset of NMF object") checkEquals(a[2:3, drop=TRUE], basis(a)[,2:3, drop=TRUE], "subset with single vector index + dropping returns correct matrix if length > 1") checkIdentical(a[2:3, drop=FALSE], a[,,2:3], "subset with single vector index + NOT dropping returns correct matrix if length > 1") # subset on both features and samples checkEquals(dim(a[1,1]), c(1, 1, r), "subset 1 feature x 1 sample is OK (dim)") checkEquals(coef(a[3,5]), coef(a)[,5, drop=FALSE], "subset 1 feature x 1 sample is OK (coef)") checkEquals(basis(a[3,5]), basis(a)[3,, drop=FALSE], "subset 1 feature x 1 sample is OK (basis)") checkEquals(dim(a[10:19,5:11]), c(10, 7, r), "subset more than 1 feature x sample is OK (dim)") checkEquals(coef(a[10:19,5:11]), coef(a)[,5:11], "subset more than 1 feature x sample is OK (coef)") checkEquals(basis(a[10:19,5:11]), basis(a)[10:19,], "subset more than 1 feature x sample is OK (basis)") } #' Tests for get/set misc elements in NMF models test.misc <- function(){ x <- nmfModel() m <- slot(x, 'misc') checkTrue(is.list(m) && length(m)==0L, 'On empty model misc is an empty list') checkEquals(misc(x), m, 'On empty model misc() returns an empty list') x$a <- 3 checkEquals(slot(x, 'misc'), list(a=3), "Setting misc with $ works") checkEquals(misc(x), list(a=3), "Getting misc with misc() works") checkEquals(x$a, 3, "Getting misc with $ works") checkEquals(misc(list()), NULL, 'On empty list misc is NULL') checkEquals(misc(list(misc=4)), 4, 'On list with a `misc` element, misc() returns the element') checkEquals(misc(1), NULL, 'On non list object misc() is NULL') a <- 1 attr(a, 'misc') <- 2 checkEquals(misc(a), 2, 'On non list object with `misc` attribute, misc() returns the attribute') }NMF/inst/tests/runit.distance.r0000644000176000001440000000375212234465004016165 0ustar ripleyusers#' Unit Testing script for NMF package: NMF distances. #' #' @author Renaud Gaujoux #' @creation 08 April 2010 .TestSeed <- 123456 # make the internal function visible if( isNamespaceLoaded('NMF') ){ .rss <- NMF:::.rss .KL <- NMF:::.KL } check.storage.mode <- function(R.fun, C.fun, name, ...){ n <- 5000; p <- 50; # create random matrices in storage mode double x <- rmatrix(n, p, min=1, max=100) y <- rmatrix(n, p, min=1, max=100) # create random matrices in storage mode integer xi <- x; storage.mode(xi) <- 'integer' yi <- y; storage.mode(yi) <- 'integer' # check result for all combinations checkEquals( R.fun(x, y, ...), C.fun(x, y), paste(name, "- Version double-double: OK" )) checkEquals( R.fun(x, yi), C.fun(x, yi), paste(name, "- Version double-integer: OK" )) checkEquals( R.fun(xi, y), C.fun(xi, y), paste(name, "- Version integer-double: OK" )) checkEquals( R.fun(xi, yi), C.fun(xi, yi), paste(name, "- Version integer-integer: OK" )) } test.rss <- function(){ set.seed(.TestSeed) # create R version for RSS R_rss <- function(x, y) sum((x-y)^2) # check the storage mode check.storage.mode(R_rss, .rss, 'RSS') } test.KL <- function(){ set.seed(.TestSeed) # create R version for RSS R_kl <- function(x, y) sum( ifelse(x==0, y, x * log(x/y) - x + y) ); # check the storage mode check.storage.mode(R_kl, .KL, 'KL divergence') # create random matrices n <- 5000; p <- 50; x <- rmatrix(n, p, min=1, max=100) y <- rmatrix(n, p, min=1, max=100) # check result with NA values z <- x; z[1,1] <- NA checkTrue( is.na(.KL(z, y)), "Return NA if there is a NA in x") checkTrue( is.na(.KL(x, z)), "Return NA if there is a NA in y") # check result with NaN values z <- x; z[1,1] <- NaN checkTrue( is.na(.KL(z, y)), "Return NA if there is a NaN in x") checkTrue( is.na(.KL(x, z)), "Return NA if there is a NaN in y") # check result with 0 values in y z <- y; z[1,1] <- 0 checkEquals( .KL(x, z), Inf, "Return Inf if there is a 0 in y") }NMF/inst/tests/runit.utils.r0000644000176000001440000001206012234465004015523 0ustar ripleyusers#' Unit Testing script for NMF package: NMF utility functions. #' #' @author Renaud Gaujoux #' @creation 10 Aug 2010 #' Unit test for rmatrix: random matrix generation test.rmatrix <- function(){ n <- 100; p <- 20 A <- matrix(1, n, p) # square matrix if y is missing set.seed(123456); M <- matrix(runif(n*n), n, n) set.seed(123456); checkIdentical(M, rmatrix(n), "Square matrix if 'y' is missing") set.seed(123456); checkIdentical(M, rmatrix(matrix(NA, nrow(M), ncol(M))), "Correct if 'x' is a matrix") # from NMF model model <- rnmf(3, A) set.seed(123456); M <- fitted(model) + matrix(runif(n*p), n, p) set.seed(123456); checkIdentical(M, rmatrix(model), "Correct if 'x' is an NMF model") set.seed(123456); M <- fitted(model) + matrix(rnorm(n*p), n, p) set.seed(123456); checkIdentical(M, rmatrix(model, dist=rnorm), "dist is passed correctly if 'x' is an NMF model") # default dist is uniform set.seed(123456); M <- matrix(runif(n*p), n, p) set.seed(123456); checkIdentical(M, rmatrix(n, p), "Default correctly to 'runif'") set.seed(123456); checkIdentical(M, rmatrix(A), "Default correctly to 'runif' (arg: matrix)") # argument byrow is correctly passed set.seed(123456); M <- matrix(runif(n*p), n, p, byrow=TRUE) set.seed(123456); checkIdentical(M, rmatrix(n, p, byrow=TRUE), "argument byrow is correctly passed") set.seed(123456); checkIdentical(M, rmatrix(A, byrow=TRUE), "argument byrow is correctly passed (arg: matrix)") # argument dimnames is correctly passed dims <-list(rep('a',n), rep('b',p)) set.seed(123456); M <- matrix(runif(n*p), n, p, dimnames=dims) set.seed(123456); checkIdentical(M, rmatrix(n, p, dimnames=dims), "argument dimnames is correctly passed") set.seed(123456); checkIdentical(M, rmatrix(A, dimnames=dims), "argument dimnames is correctly passed (arg: matrix)") # can pass distribution function set.seed(123456); M <- matrix(rnorm(n*p), n, p) set.seed(123456); checkIdentical(M, rmatrix(n, p, dist=rnorm), "argument dist is correctly passed") set.seed(123456); checkIdentical(M, rmatrix(A, dist=rnorm), "argument dist is correctly passed (arg: matrix)") # can pass distribution functions as third argument set.seed(123456); M <- matrix(rnorm(n*p), n, p) set.seed(123456); checkIdentical(M, rmatrix(n, p, rnorm), "argument dist is the third argument") set.seed(123456); checkIdentical(M, rmatrix(A, rnorm), "argument dist is the second argument (arg: matrix)") # can pass extra arguments to distribution function set.seed(123456); M <- matrix(rnorm(n*p, 20), n, p) set.seed(123456); checkIdentical(M, rmatrix(n, p, rnorm, mean=20), "extra arguments are passed to the distribution function") set.seed(123456); checkIdentical(M, rmatrix(A, rnorm, mean=20), "extra arguments are passed to the distribution function (arg: matrix)") } #test.ptr_neq_constraints <- function(){ # # .do_constrain <- function(...){ # # } # # .check <- function(c, msg){ # .msg <- function(...) paste(msg, ':', ...) # x <- rmatrix(20,3) # y <- NMF:::neq.constraints.inplace(x, copy=TRUE) # checkIdentical(max.col(y[1:9,]), c(rep(1,3), rep(2,3), rep(3,3)), .msg("Max are ok")) # checkIdentical(y[-(1:9,], , .msg("Non constrained rows are identical")) # } # # #.check(list(1:3,4:6,7:9), "") # # # #} test.nmfWrapper <- function(){ .msg <- NULL msg <- function(...) paste(.msg, ': ', ..., sep='') f <- nmfWrapper('lee') x <- rmatrix(20, 10) checkTrue( isNMFfit(res <- f(x, 3)), msg('result is an NMFfit object') ) checkIdentical(nbasis(res), 3L, msg('result was computed using the correct rank') ) checkIdentical(algorithm(res), 'lee', msg('result was computed using the correct algorithm') ) .msg <- 'with default maxIter and seed value' f <- nmfWrapper('nsNMF', maxIter=3, seed='nndsvd') checkTrue( isNMFfit(res <- f(x, 2)), msg('result is an NMFfit object' )) checkIdentical(nbasis(res), 2L, msg('result was computed using the correct rank') ) checkIdentical(algorithm(res), 'nsNMF', msg('result was computed using the correct algorithm') ) checkIdentical(niter(res), 3L, msg('result was computed using the correct number of iterations') ) checkIdentical(seeding(res), 'nndsvd', msg('result was computed using the correct seed') ) # overwrite default in call .msg <- 'overwriting defaults in call' checkTrue( isNMFfit(res <- f(x, 4, seed='random')), msg('result is an NMFfit object' )) checkIdentical(nbasis(res), 4L, msg('result was computed using the correct rank') ) checkIdentical(algorithm(res), 'nsNMF', msg('result was computed using the correct algorithm') ) checkIdentical(niter(res), 3L, msg('result was computed using the correct number of iterations') ) checkIdentical(seeding(res), 'random', msg('result was computed using the correct seed') ) # pass method as well .msg <- 'overwriting defaults in call + try overwrite method' checkWarning(res <- f(x, 4, method='lee', seed='random'), 'Discarding fixed arguments.*', msg('a warning is thrown')) checkTrue( isNMFfit(res), msg('result is an NMFfit object' )) checkIdentical(algorithm(res), 'nsNMF', msg('result was still computed using the correct algorithm defined in nmfWrapper') ) }NMF/inst/tests/runit.NMFStrategy-class.r0000644000176000001440000001222712234465004017636 0ustar ripleyusers#' Unit Testing script for NMF package: virtual class NMFStrategy #' #' @author Renaud Gaujoux #' @creation 14 Aug 2009 # make the internal functions/objects visible if( isNamespaceLoaded('NMF') ){ name <- NMF:::name `name<-` <- NMF:::`name<-` is.mixed <- NMF:::is.mixed } .TestSeed <- 123456 #' Unit test for constructor test.constructor <- function(){ # no arguments checkException( new('NMFStrategy'), 'Class is virtual') # define a sub-class setClass('A', contains='NMFStrategy') on.exit(removeClass('A'), add=TRUE) # with just name #checkException( new('A', name=character()), 'Error if slot name is a null character string') checkException( new('A', name=''), 'Error if slot name is an empty character string') checkTrue( validObject(new('A', name='toto')), 'No error if object with non empty name') # with objective function checkException( new('A', name='toto', objective=4), 'Error if slot objective is NOT a character or function (numeric)') checkException( new('A', name='toto', objective=''), 'Error if slot objective is an empty character string') checkTrue( validObject(new('A', name='toto', objective='tata')), 'No error if slot objective is a non empty character string') checkTrue( validObject(new('A', name='toto', objective=function(){})), 'No error if slot objective is a function') # with model checkException( new('A', name='toto', model=''), 'Error if slot model is an empty character string') checkException( new('A', name='toto', model='toto'), 'Error if slot model is not an sub-class of class NMF') #Now it is allowed to set the model to 'NMF' #checkException( new('A', name='toto', model='NMF'), 'Error if slot model is class NMF') checkTrue( validObject( new('A', name='toto', model='NMFstd')) , "Valid object if slot model is 'NMFstd'") checkTrue( validObject( new('A', name='toto', model='NMFns')), "Valid object if slot model is a subclass of class 'NMF'") checkTrue( validObject( new('A', name='toto', model=c('NMFns','NMFOffset'))), "Valid object if slot model is vector of subclasses of class 'NMF'") # with mixed set checkException( new('A', name='toto', mixed='toto'), 'Error if slot mixed is not logical') checkException( new('A', name='toto', mixed=c(TRUE, FALSE)), 'Error if slot mixed is not length 1') checkTrue( validObject( new('A', name='toto', mixed=TRUE) ), 'Valid object if slot mixed is TRUE' ) checkTrue( validObject( new('A', name='toto', mixed=TRUE) ), 'Valid object if slot mixed is FALSE' ) } check.slots.methods <- function(obj, title=''){ checkEquals( name(obj), obj@name, paste(title, ": slot methods for 'name' give same result")) checkEquals( objective(obj), obj@objective, paste(title, ": slot methods for 'objective' give same result")) checkEquals( modelname(obj), obj@model, paste(title, ": slot methods for 'model' give same result")) checkEquals( is.mixed(obj), obj@mixed, paste(title, ": slot methods for 'mixed' give same result")) } #' Unit test for accessors test.accessors <- function(){ # define a sub-class setClass('A', contains='NMFStrategy') on.exit(removeClass('A'), add=TRUE) # create an object a <- new('A') # prototype is not valid checkException( validObject(a), 'Prototype object is not valid') check.slots.methods(a, 'Prototype object') # slot name # checkException( a@name <- '', "Method @<-: Error if setting slot 'name' to ''") # checkException( a@name <- character(), "Method @<-: Error if setting slot 'name' to character()") # checkException( a@name <- 4, "Method @<-: Error if setting slot 'name' to not character") checkException( name(a) <- '', "Method name<-: Error if setting slot 'name' to ''") checkException( name(a) <- character(), "Method name<-: Error if setting slot 'name' to character()") checkException( name(a) <- 4, "Method name<-: Error if setting slot 'name' to not character") name(a) <- 'toto' checkEquals( a@name, 'toto', "Method name<-: set slot 'name' correctly") check.slots.methods(a, 'Object after name set by name<-') # slot objective checkException( objective(a) <- '', "Method objective<-: Error if setting slot 'objective' to ''") checkException( objective(a) <- character(), "Method objective<-: Error if setting slot 'objective' to character()") checkException( objective(a) <- 4, "Method objective<-: Error if setting slot 'objective' to not character") objective(a) <- 'toto' checkEquals( a@objective, 'toto', "Method objective<-: set slot 'objective' correctly") check.slots.methods(a, 'Object after name set by objective<-') objective(a) <- function(...){} checkEquals( a@objective, function(...){}, "Method objective<-: set slot 'objective' correctly") check.slots.methods(a, 'Object after name set by objective<-') } checkClass <- function(x, cl, msg){ checkEquals(class(x)[1L], cl, paste(msg, "[object of class '", class(x)[1L],"']")) } test.constructorMethod <- function(){ checkClass(NMFStrategy('a', Update=function(i, y, x, ...){}), 'NMFStrategyIterative', 'With argument `Update`') checkClass(NMFStrategy('a', function(i, y, x, ...){}), 'NMFStrategyFunction', 'With method=function') checkClass(NMFStrategy('a', algorithm=function(i, y, x, ...){}), 'NMFStrategyFunction', 'With argument `algorithm`') } NMF/inst/tests/runit.parallel.r0000644000176000001440000002234312307621244016165 0ustar ripleyusers# Test parallel computations # # Author: Renaud Gaujoux ############################################################################### # make the internal functions/objects visible if( isNamespaceLoaded('NMF') ){ setupLibPaths <- NMF:::setupLibPaths setupBackend <- NMF:::setupBackend } library(stringr) library(foreach) shared_DEACTIVATED <- function(...){ msg <- NULL if( .Platform$OS.type == 'windows' ) msg <- str_c(..., ' [OS: Windows]') else if( !require.quiet(bigmemory) ) msg <- str_c(..., ' [missing: bigmemory]') else if( !require.quiet(synchronicity) ) msg <- str_c(..., ' [missing: synchronicity]') if( !is.null(msg) ) DEACTIVATED(msg) } check_shared_memory <- function(.msg, libs=TRUE, seq=FALSE){ .test <- function(.msg, mutex, libs, seq){ mess <- function(...){ paste(.msg , if( mutex ) "With mutex" else "No mutex" , ":", ...) } mtx <- if( mutex ) ts_eval() else force if( libs ) setupLibPaths() alpha <- 5 res <- foreach(i=1:4) %dopar% { t <- Sys.time() if( i==1 ) mtx(Sys.sleep(3)) else if( i== 2) Sys.sleep(0.2) mtx({a <- runif(i); c <- 10 * i; d <- alpha + i}) b <- c list(i, Sys.getpid(), t, Sys.time(), a, b, c, d) } pids <- sapply(res, '[[', 2) wtime <- sapply(res, function(x) round(as.numeric(x[[4]] - x[[3]]), 2)) pid <- unique(pids) stopifnot( length(pid) == if( seq ) 1L else 2L ) # check evaluation checkEquals( length(unlist(lapply(res,'[[', 5))), 4 *5 /2, mess("Evaluation of random draws is OK")) checkIdentical( sapply(res,'[[', 6), 1:4 * 10, mess("Evaluation outside eval call is OK")) checkIdentical( sapply(res,'[[', 7), 1:4 * 10, mess("Evaluation inside eval call is OK")) checkIdentical( sapply(res,'[[', 8), alpha + 1:4, mess("Evaluation inside eval call with exported variable is OK")) # return time differences ipid <- if( seq ) 1:2 else c(which(pids == pid[1])[1L], which(pids == pid[2])[1L]) wt <- wtime[ipid] # message(mess()) # message( str_out(wt)) wt } mess <- function(...) paste(.msg, ":", ...) # restore doSEQ backend on.exit on.exit( registerDoSEQ() ) # no mutex wtime <- .test(mess(), mutex=FALSE, libs, seq) checkTrue( wtime[1] >= 2 , mess("No mutex: Thread 1 waits 2 second (", wtime[1], ')')) checkTrue( wtime[2] < 1 , mess("No mutex: Thread 2 does not wait at all (", wtime[2], ')')) # check mutex lock shared_DEACTIVATED("NMF shared memory feature not available.") wtime <- .test(mess(), mutex=TRUE, libs, seq) checkTrue( wtime[1] >= 2 , mess("With mutex : Thread 1 waits 2 seconds (", wtime[1], ')')) if( !seq ) checkTrue( wtime[2] > 2 , mess("With mutex: Thread 2 also waits at least 2 seconds (", wtime[2], ')')) } test.shared_memory_doSEQ <- function(){ # doSEQ registerDoSEQ() check_shared_memory('doSEQ', libs=FALSE, seq=TRUE) } test.shared_memory_doMC <- function(){ # doParallel (doMC) library(doParallel) registerDoParallel(2) check_shared_memory('doParallel - Multicore', libs=FALSE) } test.shared_memory_doParallel <- function(){ # doParallel (doParallel) cl <- makeCluster(2, outfile='wout.log') on.exit( stopCluster(cl), add=TRUE) registerDoParallel(cl) check_shared_memory('doParallel') } test.shared_memory_doMPI <- function(){ DEACTIVATED("NMF shared memory feature does not currently work with doMPI.") if( !require(doMPI) ) DEACTIVATED("Package doMPI not available.") # doMPI cl_MPI <- startMPIcluster(2) on.exit( closeCluster(cl_MPI), add=TRUE) registerDoMPI(cl_MPI) check_shared_memory('doMPI') } test.setupBackend <- function(){ # restore backend on.exit on.exit( registerDoSEQ() ) checkException( setupBackend(-1, 'par', TRUE), "Invalid number of cores (optional)") checkException( setupBackend(-1, 'par', FALSE), "Invalid number of cores (required)") checkException( setupBackend(10, 'par', FALSE), "Required too many cores") checkException( setupBackend(1, 'toto', FALSE), "Required unknown backend") } test.gVariable <- function(){ # restore backend on.exit on.exit( registerDoSEQ() ) .check <- function(.msg, libs=TRUE, seq=FALSE){ on.exit( registerDoSEQ() ) .test <- function(shared){ mess <- function(...) paste(.msg, ' + shared=', shared, ":", ...) cat(mess(), "\n") # run foreach loop v <- gVariable(123, shared=shared) if( libs ) setupLibPaths(verbose = TRUE) res <- foreach(i=1:20) %dopar% { if(i==1) v(456) else if( i== 2) Sys.sleep(0.2); c(Sys.getpid(), v()) } # extract result data pids <- sapply(res, '[', 1) vals <- sapply(res, '[', 2) pid <- unique(pids) stopifnot( length(pid) == if( seq ) 1L else 2L ) # when not shared: only the iterations run by the first process see changes if( !shared && !seq ){ checkIdentical( unique(vals[pids==pid[1]]), 456, mess("Value change in first process affects first process")) checkIdentical( unique(vals[pids==pid[2]]), 123, mess("Value change ins first process does not affect second process")) } else{ checkIdentical( unique(vals), 456 , mess("Value change affects all processes")) } } .test(FALSE) shared_DEACTIVATED("NMF global shared variables not available.") .test(TRUE) } # doSEQ registerDoSEQ() .check('doSEQ', libs=FALSE, seq=TRUE) # doParallel (Multicore) library(doParallel) registerDoParallel(2) .check('doParallel - Multicore') # doParallel (doSNOW) cl <- makeCluster(2, outfile='wout.log') on.exit( stopCluster(cl), add=TRUE) registerDoParallel(cl) .check('doParallel') # doMPI if( !require(doMPI) ) DEACTIVATED("Package doMPI not available.") cl_MPI <- startMPIcluster(2) on.exit( closeCluster(cl_MPI), add=TRUE) registerDoMPI(cl_MPI) .check('doMPI') } test.ForeachBackend <- function(){ .check <- function(type, n, ...){ b <- ForeachBackend(...) checkIdentical(class(b), c(str_c(type, '_backend'), 'foreach_backend'), str_c(type, ": Class is ok")) b } # doParallel (Multicore) library(doParallel) .check('doParallel', 3, 'PAR', 3) # doParallel (SNOW) cl <- makeCluster(2) on.exit( stopCluster(cl), add=TRUE) b <- .check('doParallel', 2, cl) # doMPI if( !require(doMPI) ) DEACTIVATED("Package doMPI not available.") b <- .check('doMPI', 2, 'MPI', 2) cl_MPI <- startMPIcluster(2) on.exit( closeCluster(cl_MPI), add=TRUE) b <- .check('doMPI', 2, cl_MPI) } test.nmf <- function(){ on.exit( registerDoSEQ() ) set.seed(123456) a <- rmatrix(20,10) nmf.options(cores=2) checkTrue( isNMFfit(resREF <- nmf(a, 2, seed=123, nrun=3, .opt='v3')), "Default works") cl_loadedNamespaces <- function(cl=NULL){ if( is_NA(cl) ) return() if( is.null(cl) ) unique(unlist(foreach(i=1:2) %dopar% { loadedNamespaces() })) else unique(unlist(clusterApplyLB(cl, 1:2, function(i){ loadedNamespaces() }))) } .check <- function(msg, .options=NULL, ..., LOADED_NAMESPACES=NA){ be <- getDoBackend() checkTrue( isNMFfit(res2 <- nmf(a, 2, seed=123, nrun=3, .opt=str_c('v3', .options), ...)), str_c(msg, " works")) # retrieve namespaces on dopar processes if necessary ns <- if( !is_NA(LOADED_NAMESPACES) ) cl_loadedNamespaces(LOADED_NAMESPACES) checkTrue( nmf.equal(resREF, res2), str_c(msg, ": result is identical to default") ) checkIdentical( consensus(resREF, no.attrib=TRUE), consensus(res2, no.attrib=TRUE) , str_c(msg, ": consensus matrice (no.attrib) is identical to default") ) checkIdentical( consensus(resREF), consensus(res2), str_c(msg, ": consensus matrice is identical to default") ) checkTrue( identical(be, getDoBackend()), str_c(msg, ": backend is restored") ) # check restoration on error checkException( nmf(a, 2, method=function(...) 1L, seed=123, nrun=3, .opt=str_c('v3', .options), ...), str_c(msg, " throw error if bad method")) checkTrue( identical(be, getDoBackend()), str_c(msg, ": backend is restored after error") ) # return loaded namespaces ns } library(parallel) .check('SEQ', .pbackend='SEQ') # Multicore if( parallel::detectCores() > 1 ) .check('P2', .options='P2') # SNOW-type from char spec .check('.pbackend="psock"', .options='P2', .pbackend='PSOCK') # SNOW-type cl <- makeCluster(2) on.exit( stopCluster(cl), add=TRUE) lpkg0 <- cl_loadedNamespaces(cl) lpkg1 <- .check('.pbackend=cl + SNOW-like cluster', .pbackend=cl, LOADED_NAMESPACES=cl) # if( !isCHECK() ){ #TODO: investigate why this test does not work in R CMD check # checkTrue(length(setdiff(lpkg1, lpkg0)) > 0, "Provided cluster was used if .pbackend=cl") # } stopCluster(cl) library(doParallel) cl <- makeCluster(2) registerDoParallel(cl) lpkg0 <- cl_loadedNamespaces(NULL) # no .pbackend => use registered cluster lpkg1 <- .check('doParallel registered cluster + P2 [should not use registered cluster]', .opt='P2' , LOADED_NAMESPACES=NULL) checkIdentical(lpkg0, lpkg1, "Registered cluster was not used if .opt='P2'") # .pbackend=NULL lpkg1 <- .check('.pbackend=NULL + doParallel registered cluster', .pbackend=NULL , LOADED_NAMESPACES=NULL) checkTrue(length(setdiff(lpkg1, lpkg0))>0, "Registered cluster was used if .pbackend=NULL") # MPI if( !require(doMPI) ) DEACTIVATED("Package doMPI not available.") cl_MPI <- startMPIcluster(2) on.exit( closeCluster(cl_MPI), add=TRUE) .check('.pbackend=cl_MPI + MPI cluster', .pbackend=cl_MPI) registerDoMPI(cl_MPI) .check('.pbackend=NULL + doMPI registered MPI cluster', .pbackend=NULL) } NMF/inst/tests/runit.options.r0000644000176000001440000000342112234465004016057 0ustar ripleyusers#' Unit Testing script for NMF package: package specific options #' #' @author Renaud Gaujoux #' @creation 25 July 2009 # make the internal functions/objects visible if( isNamespaceLoaded('NMF') ){ #.nmf.Options.Runtime <- NMF:::.nmf.Options.Runtime } test.nmf.options <-function(){ # clean up removing created options OLD <- nmf.options() on.exit( nmf.options(OLD) ) checkTrue( is.list(nmf.options()), 'Options are returned as a list' ) checkTrue( is.list(nmf.options('error.track', 'debug')), 'Options are returned as a list' ) checkTrue( is.list(nmf.options('error.track')), 'Single option is returned as a list') checkEquals( nmf.options('toto'), list(toto=NULL), 'Unknow in nmf.options returns NULL correctly named') checkTrue( !is.null(nmf.options(toto=6)), 'Can add new option') nmf.options(tata=10) opt <- nmf.options() checkEquals( o <- nmf.options(toto=5, tata=9, titi=25), list(toto=6, tata=10, titi=NULL), 'Changing options return old values') checkIdentical({nmf.options(o); nmf.options()}, opt, "Restoring options works" ) nmf.options(toto=4) checkEquals( nmf.options(toto=NULL), list(toto=4), 'Removing an option returns old value') checkTrue( !is.element('toto', names(nmf.options())), 'Removing an option actually removes it from the option list') #checkException( nmf.options(debug=NULL), 'Removing built-in option is throws an error') } test.nmf.getOption <-function(){ # clean up removing created options OLD <- nmf.options() on.exit( nmf.options(OLD) ) checkTrue( is.null(nmf.getOption('toto')), 'Unknow in nmf.getOption returns NULL') nmf.options(toto=5) checkEquals( nmf.getOption('toto'), 5, 'nmf.getOption returns correct value') # clean up removing created options nmf.options(toto=NULL) } NMF/inst/tests/runit.algorithms.r0000644000176000001440000001743112307621244016544 0ustar ripleyusers#' Unit Testing script for NMF package: NMF algorithms. #' #' @author Renaud Gaujoux #' @creation 22 April 2009 library(rngtools) .TestSeed <- 123456 .testData <- function(n=20, r=3, m=10, ...){ syntheticNMF(n, r, m, ...) } checkNMFPlot <- function(V, res, prefix=''){ if( isCHECK() ) return() # check heatmaps of the target matrix, the metaprofiles and the metagenes checkPlot( aheatmap(V), paste(prefix, ': Target')) checkPlot( coefmap(res), paste(prefix, ': Metaprofiles')) checkPlot( basismap(res), paste(prefix, ': Metagenes')) } #' Tests an algorithm on all data: synthetic, Golub, Cell-type checkData <- function(meth, ...){ message("\n###############\n#", meth, "\n###############") # On synthetic data #1. with noise set.seed(.TestSeed) r <- 3; V <- .testData(r=r) n <- nrow(V); m <- ncol(V); res <- nmf(V, r, meth, ..., rng=1234) # check the consistency of the result checkTrue( validObject(res), 'Returned object is valid') checkEquals(nrow(res), n, 'W has correct number of rows', checkNames=FALSE) checkEquals(nbasis(res), r, 'Result has correct rank', checkNames=FALSE) checkEquals(ncol(res), m, 'H has correct number of columns', checkNames=FALSE) checkEquals(algorithm(res), meth, "Algorithm's name is correctly set", checkNames=FALSE) wr <- nmfWrapper(meth) checkTrue( isNMFfit(resWrapper <- wr(V, r, ..., rng=1234)), 'Wrapper call works') checkTrue( nmf.equal(res, resWrapper), 'Wrapper call gives identical result') # check heatmaps checkNMFPlot(V, res, 'Synthetic [noise]') #2. with noise + offset n.offset <- 15 o <- c(rep(1, n.offset), rep(0, n-n.offset)) set.seed(.TestSeed) V <- syntheticNMF(n, r, m, offset=o, noise=TRUE) res <- nmf(V, r, meth, ...) # check heatmaps checkNMFPlot(V, res, 'Synthetic [noise + offset]') # On Golub data data(esGolub) eset <- esGolub[1:50,] # check the heatmap of the target expression matrix set.seed(.TestSeed) res <- nmf(eset, r, meth, ...) # check heatmaps checkNMFPlot(exprs(eset), res, 'Golub') return() # On Cell-type data data(CellType) eset <- esCellType[1:100,] V <- exp(exprs(eset)) # check the heatmap of the target expression matrix set.seed(.TestSeed) res <- nmf(V, r, meth, ...) # check heatmaps checkNMFPlot(V, res, 'Cell-type') } #' Tests Brunet algorithm test.brunet <- function(){ checkData('brunet') } #' Tests KL algorithm test.KL <- function(){ checkData('KL') } #' Tests Lee algorithm test.lee <- function(){ checkData('lee') } #' Tests Frobenius algorithm test.frobenius <- function(){ checkData('Frobenius') } #' Test NMF with offset test.offset <- function(){ checkData('offset') } #' Test Nonsmooth NMF test.ns <- function(){ checkData('nsNMF', theta=0.6) } #' Test Sparse NMF (i.e. NNLS) test.snmf <- function(){ checkData('snmf/r')#, version='R') checkData('snmf/l')#, version='L') # check errors due to parameter checks set.seed(.TestSeed) V <- .testData() # beta checkException(nmf(V, 3, 'snmf/r', beta=0), 'beta: 0 is not a valid value') checkException(nmf(V, 3, 'snmf/r', beta=-1), 'beta: <0 is not a valid value') # bi_conv checkException(nmf(V, 3, 'snmf/r', bi_conv=-1), 'bi_conv: 1-length vector is not a valid value') checkException(nmf(V, 3, 'snmf/r', bi_conv=c(-1, 10, 3)), 'bi_conv: > 2-length vector is not a valid value') checkException(nmf(V, 3, 'snmf/r', bi_conv=c(-1, 10)), 'wminchange: <0 is not a valid value') checkException(nmf(V, 3, 'snmf/r', bi_conv=c(0, -1)), 'iconv: <0 is not a valid value') # eps_conv checkException(nmf(V, 3, 'snmf/r', eps_conv=0), 'eps_conv: 0 is not a valid value') checkException(nmf(V, 3, 'snmf/r', eps_conv=-1), 'eps_conv: <0 is not a valid value') # check passage of parameters # eps_conv res <- nmf(V, 3, 'snmf/r', eps_conv=1) checkEquals(res@parameters$eps_conv, 1, 'eps_conv: argument is passed to algorithm') # eta res <- nmf(V, 3, 'snmf/r', eta=1) checkEquals(res@parameters$eta, 1, 'eta: argument is passed to algorithm') # beta res <- nmf(V, 3, 'snmf/r', beta=0.05) checkEquals(res@parameters$beta, 0.05, 'beta: argument is passed to algorithm') # bi_conv res <- nmf(V, 3, 'snmf/r', bi_conv=c(1, 10)) checkEquals(res@parameters$bi_conv, c(1, 10), 'bi_conv: argument is passed to algorithm') } #' Test Local NMF test.lnmf <- function(){ DEACTIVATED("Algorithm 'lnmf' is not fully working.") checkData('lnmf') } ##' Tests multiple runs of NMF, using Brunet algorithm Golub data. #atest.zzz.runs <- function(){ # # # define the number of runs # N <- 3 # r <- 3 # # # load data # data(esGolub) # eset <- esGolub[1:50, ] # # # run nmf N times # set.seed(.TestSeed) # res <- nmf(eset, r, 'brunet', nrun=N) # # # check the consensus matrix # checkPlot( basicHM(connectivity(res)), 'Consensus matrix') # #} #' Unit test for identical results if NMF algorithms check.algos <- function(algo1, algo2, identical=FALSE){ r <- 3 data(esGolub) eset <- esGolub[1:50,] res1 <- nmf(eset, r, algo1, seed=.TestSeed) res2 <- nmf(eset, r, algo2, seed=.TestSeed) checkTrue( nmf.equal(res2, res2, identical=identical) , paste("Results are the same for '", algo1, "' and '", algo2, "'", sep='')) } #' Unit test for C and R versions of algorithms check.cversion <- function(algo){ check.algos(paste('.R#', algo, sep=''), algo) } #' Unit test for C and R versions of the algorithm: Brunet test.cversions.brunet <- function(){ check.cversion('brunet') } #' Unit test for C and R versions of the algorithm: Lee test.cversions.lee <- function(){ check.cversion('lee') } #' Unit test for C and R versions of the algorithm: nsNMF test.cversions.ns <- function(){ check.cversion('ns') } #' Unit test for C and R versions of the algorithm: Offset test.cversions.offset <- function(){ check.cversion('offset') } #' Unit test for C and R versions of the algorithm: Lee test.cversions.lnmf <- function(){ DEACTIVATED("Algorithm 'lnmf' is not fully working.") check.cversion('lnmf') } #' Unit test for the port of `brunet` test.port_brunet <- function(){ # load RcppOctave if possible if( !require(RcppOctave) ){ DEACTIVATED("Package RcppOctave not available.") } # source o_source(file.path(packagePath('m-files', package='NMF'), 'brunet.m')) # define input data setRNG('default', 'default') set.seed(1234) x <- rmatrix(100,20) x0 <- rnmf(3, x) # run MATLAB code: brunet(v,r,verbose, w, h) o <- .CallOctave('brunet', x, 3, FALSE, basis(x0), coef(x0)) ofit <- nmfModel(o$W, o$H) checkTrue( !nmf.equal(ofit, x0), "MATLAB version returned something different than the seed model") o2 <- .CallOctave('brunet', x, 3, FALSE, basis(x0), coef(x0)) ofit2 <- nmfModel(o2$W, o2$H) checkTrue( nmf.equal(ofit, ofit2), "MATLAB version really uses the seed model") o_rm("brunet") # do not use option maxIter here. # run R port tol <- 10^-14 res <- nmf(x, 3, '.R#brunet', seed=x0, maxIter = 2000L) checkEquals(niter(res), o$niter, "Pure R and MATLAB use same number of iterations") checkTrue(nmf.equal(ofit, res, tolerance=tol) , paste("Pure R port and MATLAB results are identical at tolerance ", tol)) # C version with copy res <- nmf(x, 3, 'brunet', seed=x0, copy=TRUE, maxIter = 2000L) checkEquals(niter(res), o$niter, "C version without copy and MATLAB use same number of iterations") checkTrue(isTRUE(nmf.equal(ofit, res, tolerance=tol)) , paste("C version with copy and MATLAB results are identical at tolerance ", tol)) # C version without copy res <- nmf(x, 3, 'brunet', seed=x0, copy=FALSE, maxIter = 2000L) checkEquals(niter(res), o$niter, "C version without copy and MATLAB use same number of iterations") checkTrue(isTRUE(nmf.equal(ofit, res, tolerance=tol)) , paste("C version without copy and MATLAB results are identical at tolerance ", tol)) # check NMFStrategyOctave check.algos('brunet', '.M#brunet', identical=TRUE) } NMF/inst/tests/runit.seed.r0000644000176000001440000002471012234465004015310 0ustar ripleyusers#' Unit Testing script for NMF package: seeding methods. #' #' @author Renaud Gaujoux #' @creation 17 Jul 2009 # make the internal functions/objects visible if( isNamespaceLoaded('NMF') ){ seed <- NMF:::seed } .testData <- function(n=20, r=3, m=10, ...){ syntheticNMF(n, r, m, ...) } #' Unit test for seeding method: none test.none <- function(){ # create a random target matrix r <- 3; V <- .testData(r=r) n <- nrow(V); m <- ncol(V); # seed with the matrix obj <- seed(V, r, 'none') checkTrue( is(obj, 'NMFfit') , "Seeded object is an instance of class 'NMFfit'") checkTrue( is(fit(obj), 'NMFstd') , "Seeded model is an instance of class 'NMFstd'") checkTrue( is.empty.nmf(obj), 'Should not initialize the NMF object') checkEquals( nbasis(obj), r, 'Seeded object have the correct rank') # seed with empty object obj.init <- nmfModel(r) obj <- seed(V, obj.init, 'none') checkTrue( identical(fit(obj), obj.init), 'Empty object: seeded object is identical to the initial one') # seed with dummy object obj.init <- nmfModel(r, model='NMFstd', W=matrix(seq(n*r), n, r), H=matrix(seq(r*m), r, m)) obj <- seed(V, obj.init, 'none') checkTrue( identical(fit(obj), obj.init), 'Dummy object: seeded object is identical to the initial one') } #' Utility function for \code{test.seed}: performs a set of test on a seeded object check.seed <- function(title, obj, V, r, seeding.meth, expect.class, exact.class=TRUE){ checkTrue( inherits(obj, 'NMFfit'), paste(title, ": result class inherits from 'NMFfit'") ) checkTrue( inherits(fit(obj), 'NMF'), paste(title, ": model class inherits from 'NMF'") ) if( exact.class ) checkTrue( is(fit(obj), expect.class), paste(title, ": default class returned is '", expect.class, "'") ) else checkTrue( inherits(fit(obj), expect.class), paste(title, ": default class returned inherits from '", expect.class, "'") ) checkTrue( !is.empty.nmf(obj) , paste(title, ": Seeded object is not empty")) checkEquals( nbasis(obj), r , paste(title, ": Seeded object has correct rank")) checkEquals( nrow(obj), nrow(V) , paste(title, ": Seeded object has correct number of rows"), checkNames=FALSE) checkEquals( ncol(obj), ncol(V) , paste(title, ": Seeded object has correct number of columns"), checkNames=FALSE) checkEquals( seeding(obj), seeding.meth, "Seeding method's name is correctly set") } #' Unit test for compatibility of algorithms and seeding methods test.zzz.all <- function(){ set.seed(123) # create a random target matrix r <- 3; V <- .testData(r=r) n <- nrow(V); m <- ncol(V); # list the available algorithms algorithms <- nmfAlgorithm() algorithms <- algorithms[!algorithms %in% c('ls-nmf', 'pe-nmf', 'siNMF')] # list the available seeding methods seed.methods <- nmfSeed() seed.methods <- seed.methods[which(seed.methods != 'none')] test_algo <- function(name.algo, ..., target_rank=r){ sapply(seed.methods, function(name.seed, ...){ message("\n###########\n# ", name.algo, " + ", name.seed, "\n#############") err <- try(obj <- nmf(..., method=name.algo, seed=name.seed)) checkTrue( !is(err, 'try-error'), paste('Run OK - Algo:', name.algo, '+ Seed:', name.seed, if( is(err, 'try-error') ) paste('[Error: ', err, ']') else NULL) ) check.seed(paste('Algo:', name.algo, '+ Seed:', name.seed), obj, V, target_rank, name.seed, 'NMF', exact.class=FALSE) } , ...) } # all algorithms sapply(algorithms, test_algo, V, r) # PE-NMF test_algo('pe-nmf', V, r, alpha=1, beta=0.1) # LS-NMF test_algo('ls-nmf', V, r, weight=rmatrix(V)) # siNMF g <- gl(2, m/2) test_algo('siNMF', V ~ g, r, target_rank=r+2) } #' Utility check function: checks the range of value in a NMF object check.range <- function(title, nmf.fit, max){ obj <- fit(nmf.fit) checkTrue( all(basis(obj) <= max & basis(obj) >= 0), paste(title, ': All entries of W are between 0 and', max) ) checkTrue( all(coef(obj) <= max & coef(obj) >= 0), paste(title, ': All entries of H are between 0 and', max) ) } #' Unit test for seeding method: random test.random <- function(){ .seedTest <- 123456 # create dummy matrix V.na <- matrix(NA, 50, 20) r <- 3 # check the range of the generated values obj <- seed(V.na, r, 'random') check.range('NA matrix', obj, 1) max <- 0.05 obj <- seed(matrix(max, 50, 20), r, 'random') check.range(paste('Matrix', max), obj, max) # seed with the matrix set.seed(.seedTest) obj <- seed(V.na, r, 'random') check.seed('With matrix', obj, V.na, r, 'random', 'NMFstd') # test randomness obj2 <- seed(V.na, r, 'random') checkTrue( !identical(obj2, obj), 'Seeded objects are different if seed has not been fixed before seeding') # test reproducibility set.seed(.seedTest) obj.bis <- seed(V.na, r, 'random') checkTrue( nmf.equal(obj.bis, obj), 'Seeded NMF models are identical if seed has been reset to the same value before seeding') # seed with object set.seed(.seedTest) nmfOff <- nmfModel(r, model='NMFOffset') obj <- seed(V.na, nmfOff, 'random') max <- 1 check.seed('With NMFOffset object', obj, V.na, r, 'random', 'NMFOffset') check.range(paste('Object NMFOffset', max), obj, max) checkTrue( all(offset(fit(obj)) <= max & offset(fit(obj)) >= 0), paste('Object NMFOffset: All entries of Offset are between 0 and', max) ) # seed with numeric value res <- seed(V.na, r, .seedTest) # manually reset name for seeding method set.seed(.seedTest) checkTrue( nmf.equal(seed(V.na, r, 'random'), res), "Seeded NMF models are identical when setting random generator seed and call method 'seed' with the same numerical seed (except for name of seeding method)") } check.seed.change <- function(msg, expr, base){ bs <- .Random.seed e <- parent.frame() eval(expr, env=e) if( base ) checkTrue( any(bs != .Random.seed), paste(msg, ": .Random.seed IS changed")) else checkIdentical(bs, .Random.seed, paste(msg, ": .Random.seed is NOT changed")) } #' Unit tests for checking the impact of seeding nmf computation on the .Random.seed test.seed.effect <- function(){ # set random seed set.seed(123456) # create a random target matrix r <- 3; V <- .testData(r=r) # Single runs check.seed.change("After single run without seed", nmf(V, r), TRUE) check.seed.change("After single run without seed (NO-REPRO has no effect)", nmf(V, r), TRUE) check.seed.change("After single run with seed", nmf(V, r, seed=123), FALSE) # # Multiple runs: NO seed check.seed.change("After multiple runs without seed (sapply)", nmf(V, r, nrun=3, .opt='-p'), TRUE) check.seed.change("NO-REPRO: After multiple runs without seed (sapply)", nmf(V, r, nrun=3, .opt='-pR'), TRUE) check.seed.change("After multiple runs without seed (foreach-MC)", nmf(V, r, nrun=3, .opt='P', .pbackend='par'), TRUE) check.seed.change("NO-REPRO: After multiple runs without seed (foreach-MC)", nmf(V, r, nrun=3, .opt='P-R', .pbackend='par'), TRUE) check.seed.change("After multiple runs without seed (foreach-SEQ)", nmf(V, r, nrun=3, .opt='P', .pbackend='seq'), TRUE) check.seed.change("NO-REPRO: After multiple runs without seed (foreach-SEQ)", nmf(V, r, nrun=3, .opt='P-R', .pbackend='seq'), TRUE) # Multiple runs: WITH numeric seed check.seed.change("After multiple runs with seed (sapply)", nmf(V, r, nrun=3, seed=1234, .opt='-p'), FALSE) check.seed.change("NO-REPRO: After multiple runs with seed (sapply)", nmf(V, r, nrun=3, seed=1234, .opt='-pR'), FALSE) check.seed.change("After multiple runs with seed (foreach-MC)", nmf(V, r, nrun=3, seed=1234, .opt='P', .pback='par'), FALSE) check.seed.change("NO-REPRO: After multiple runs with seed (foreach-MC)", nmf(V, r, nrun=3, seed=1234, .opt='P-R', .pback='par'), FALSE) check.seed.change("After multiple runs with seed (foreach-SEQ)", nmf(V, r, nrun=3, seed=1234, .opt='P', .pback='seq'), FALSE) check.seed.change("NO-REPRO: After multiple runs with seed (foreach-SEQ)", nmf(V, r, nrun=3, seed=1234, .opt='P-R', .pback='seq'), FALSE) # Multiple runs: WITH NA seed # check.seed.change("After multiple runs with NA seed (sapply)", nmf(V, r, nrun=3, seed=NA, .opt='-p'), FALSE) # check.seed.change("NO-REPRO: After multiple runs with NA seed (sapply)", nmf(V, r, nrun=3, seed=NA, .opt='-pR'), TRUE) # check.seed.change("After multiple runs with NA seed (foreach-MC)", nmf(V, r, nrun=3, seed=NA, .opt='P', .pback='par'), FALSE) # check.seed.change("NO-REPRO: After multiple runs with NA seed (foreach-MC)", nmf(V, r, nrun=3, seed=NA, .opt='P-R', .pback='par'), FALSE) # check.seed.change("After multiple runs with NA seed (foreach-SEQ)", nmf(V, r, nrun=3, seed=NA, .opt='P', .pback='seq'), FALSE, TRUE) # check.seed.change("NO-REPRO: After multiple runs with NA seed (foreach-SEQ)", nmf(V, r, nrun=3, seed=NA, .opt='P-R', .pback='seq'), TRUE) } #' test the restoration of the random seed test.restore <- function(){ DEACTIVATED("The option 'restore.seed' is deprecated. Related tests are now in test.seed.effect") # create a random target matrix r <- 3; V <- .testData(r=r) # default call no seed os <- .Random.seed nmf(V, r) checkTrue( !(all.equal(os, .Random.seed) == TRUE ), "call with no seed: seed is correctly NOT restored") # default call os <- .Random.seed nmf(V, r, seed=1) checkIdentical(os, .Random.seed, "Default behaviour is to restore the seed: seed is correctly restored") # force restore os <- .Random.seed nmf(V, r, .opt='r', seed=12) checkIdentical(os, .Random.seed, "force seed restoration with 'r': seed correctly restored") os <- .Random.seed nmf(V, r, .opt=list(restore.seed=TRUE), seed=123) checkIdentical(os, .Random.seed, "force seed restoration with 'restore.seed=TRUE': seed correctly restored") # do not restore os <- .Random.seed nmf(V, r, .opt='-r', seed=1234) checkTrue( !(all.equal(os, .Random.seed) == TRUE), "Disable seed restoration with '-r': seed correctly NOT restored") os <- .Random.seed nmf(V, r, .opt=list(restore.seed=FALSE), seed=12345) checkTrue( !(all.equal(os, .Random.seed) == TRUE), "force seed restoration with 'restore.seed=FALSE': seed correctly NOT restored") } #' Unit test for seeding method: Non-Negative Double SVD (nndsvd) test.nndsvd <- function(){ .seedTest <- 123456 set.seed(.seedTest) # create a random target matrix r <- 3; V <- .testData(r=r) # perform NMF with seed 'nndsvd' check.seed.change('seeding with "nndsvd"', obj <- seed(V, r, 'nndsvd'), FALSE) check.seed('With matrix', obj, V, r, 'nndsvd', 'NMF') # redo: should be the same (one needs identical=FALSE because svd() may return slightly different values) obj.bis <- seed(V, r, 'nndsvd') checkTrue( nmf.equal(obj.bis, obj, identical=FALSE), 'Seeded NMF models are identical for every run') } NMF/inst/scripts/0000755000176000001440000000000012234465004013366 5ustar ripleyusersNMF/inst/scripts/report.Rmd0000644000176000001440000000334612234465004015353 0ustar ripleyusers ```{r setup, echo = FALSE} library(knitr) library(NMF) options(width = 300) opts_knit$set(root.dir = opts_knit$get('output.dir')) ``` # Input ## Method definition ```{r load_custom} if( file.exists(f <- file.path(opts_knit$get('output.dir'), 'functions.R')) ){ cat("Sourcing custom definition in '", f,"' ... ", sep ='') source(f) cat('OK\n') } ``` ## Data ```{r data} # Target matrix class(x) dim(x) head(x[, 1:5]) ``` ## Parameters ```{r args} # Factorisation ranks rank # Methods unlist(method) # Reference class summary(colClass) ``` # Run ```{r run} # run NMF for all ranks res <- nmfRun(x, rank, method) ``` # Results ## Plots ```{r resplots, echo = FALSE, fig.width = 10, fig.height = 7} dummy <- lapply(names(res), function(x){ cat("##", x, "\n") fit <- res[[x]] # consensus map consensusmap(fit, main = x, annCol = colClass) # measures if( length(rank) > 1){ p <- plot(fit) print(p) } }) ``` ## Accuracy ```{r summary, echo = FALSE, fig.width = 15, fig.height = 8} # compute summary measures for all survey fits s <- lapply(names(res), function(x){ NMF::summary(res[[x]], class = colClass) }) # complete missing measures snames <- unique(unlist(lapply(s, names))) s <- lapply(s, function(x){ if( any(i <- !snames %in% names(x)) ){ nas <- rep(NA, nrow(x)) x <- cbind(x, sapply(snames[i], function(x) nas)) } x[, snames] }) print(s_all <- do.call(rbind, s)) library(reshape2) accuracy <- melt(s_all, id.vars = c('method', 'seed', 'rank', 'metric')) accuracy <- accuracy[!accuracy$variable %in% c('rng', 'nrun'),] ggplot(accuracy) + geom_bar(aes(x = rank, y = value, fill = method), position='dodge', stat='identity') + facet_wrap(~variable, scales = 'free') + scale_x_discrete(breaks = unique(accuracy$rank)) ``` NMF/inst/scripts/grid.R0000644000176000001440000000375612234465004014451 0ustar ripleyusers# NMF package # # Helper code to allow mixing grid/base graphics. # This code is only loaded with the explicit request of the user, # either via option 'grid.patch' or environment variable R_PACKAGE_NMF_GRID_PATCH. # # The functions in this file were adapted from the grid package, which is # under the following GPL license: # # R : A Computer Language for Statistical Data Analysis # Copyright (C) 2001-3 Paul Murrell # 2003 The R Core Team # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, a copy is available at # http://www.r-project.org/Licenses/ # # Author: Renaud Gaujoux # Created: Sep 16, 2013 ############################################################################### # This is essentially where the patch lies: not calling L_gridDirty grid.Call <- function (fnname, ...) { #.Call(L_gridDirty) .Call(fnname, ..., PACKAGE = "grid") } # One has to test for nullity since not using L_gridDirty means potentially # returning a NULL viewport current.viewport <- function() { cv <- grid.Call(grid:::L_currentViewport) if( !is.null(cv) ) grid:::vpFromPushedvp(cv) } # same thing here: call patched current.viewport and # check for nullity current.vpPath <- function(){ names <- NULL pvp <- current.viewport() if( is.null(pvp) ) return(NULL) while ( !is.null(pvp) && !grid:::rootVP(pvp)) { names <- c(names, pvp$name) pvp <- pvp$parent } if (!is.null(names)) grid:::vpPathFromVector(rev(names)) else names } NMF/inst/doc/0000755000176000001440000000000012311534443012444 5ustar ripleyusersNMF/inst/doc/heatmaps.Rnw0000644000176000001440000004455212311534443014750 0ustar ripleyusers%\VignetteIndexEntry{NMF: generating heatmaps} %\VignetteDepends{utils,NMF,RColorBrewer,knitr,bibtex} %\VignetteKeyword{aplot} %\VignetteCompiler{knitr} %\VignetteEngine{knitr::knitr} \documentclass[a4paper]{article} %\usepackage[OT1]{fontenc} \usepackage[colorlinks]{hyperref} \usepackage{a4wide} \usepackage{xspace} \usepackage[all]{hypcap} % for linking to the top of the figures or tables % add preamble from pkgmaker <>= pkgmaker::latex_preamble() @ \newcommand{\nmfpack}{\pkgname{NMF}} \newcommand{\MATLAB}{MATLAB\textsuperscript{\textregistered}\xspace} \newcommand{\refeqn}[1]{(\ref{#1})} % REFERENCES \usepackage[citestyle=authoryear-icomp , doi=true , url=true , maxnames=1 , maxbibnames=15 , backref=true , backend=bibtex]{biblatex} \AtEveryCitekey{\clearfield{url}} <>= pkgmaker::latex_bibliography('NMF') @ \newcommand{\citet}[1]{\textcite{#1}} \renewcommand{\cite}[1]{\parencite{#1}} \DefineBibliographyStrings{english}{% backrefpage = {see p.}, % for single page number backrefpages = {see pp.} % for multiple page numbers } % % boxed figures \usepackage{float} \floatstyle{boxed} \restylefloat{figure} \usepackage{array} \usepackage{tabularx} \usepackage{mathabx} \usepackage{url} \urlstyle{rm} % use cleveref for automatic reference label formatting \usepackage[capitalise, noabbrev]{cleveref} % define commands for notes \usepackage{todonotes} \newcommand{\nbnote}[1]{\ \bigskip\todo[inline, backgroundcolor=blue!20!white]{\scriptsize\textsf{\textbf{NB:} #1}}\ \\} % put table of contents on two columns \usepackage[toc]{multitoc} \setkeys{Gin}{width=0.95\textwidth} \begin{document} <>= #options(prompt=' ') #options(continue=' ') set.seed(123456) library(NMF) @ \title{Generating heatmaps for Nonnegative Matrix Factorization\\ \small Package \nmfpack\ - Version \Sexpr{utils::packageVersion('NMF')}} \author{Renaud Gaujoux} \maketitle \begin{abstract} This vignette describes how to produce different informative heatmaps from NMF objects, such as returned by the function \code{nmf} in the \citeCRANpkg{NMF}. The main drawing engine is implemented by the function \code{aheatmap}, which is a highly enhanced modification of the function \code{pheatmap} from the \CRANpkg{pheatmap}, and provides convenient and quick ways of producing high quality and customizable annotated heatmaps. Currently this function is part of the package \nmfpack, but may eventually compose a separate package on its own. \end{abstract} {\small \tableofcontents} \section{Preliminaries} \subsection{Quick reminder on NMF models} Given a nonnegative target matrix $X$ of dimension $n\times p$, NMF algorithms aim at finding a rank $k$ approximation of the form: $$ X \approx W H, $$ where $W$ and $H$ are nonnegative matrices of dimensions $n\times k$ and $k\times p$ respectively. The matrix $W$ is the basis matrix, whose columns are the basis components. The matrix $H$ is the mixture coefficient or weight matrix, whose columns contain the contribution of each basis component to the corresponding column of $X$. We call the rows of $H$ the basis profiles. \subsection{Heatmaps for NMF} Because NMF objects essentially wrap up a pair of matrices, heatmaps are convenient to visualise the results of NMF runs. The package \nmfpack provides several specialised heatmap functions, designed to produce heatmaps with sensible default configurations according to the data being drawn. Being all based on a common drawing engine, they share almost identical interfaces and capabilities. The following specialised functions are currently implemented: \begin{description} \item[\code{basismap}] draws heatmaps of the basis matrix \item[\code{coefmap}] draws heatmaps of the mixture coefficient matrix \item[\code{consensusmap}] draws heatmaps of the consensus matrix, for results of multiple NMF runs. \end{description} \subsection{Heatmap engine} All the above functions eventually call a common heatmap engine, with different default parameters, chosen to be relevant for the given underlying data. The engine is implemented by the function \code{aheatmap}. Its development started as modification of the function \code{pheatmap} from the \pkgname{pheatmap} package. The initial objective was to improve and increase its capabilities, as well as defining a simplified interface, more consistent with the R core function \code{heatmap}. We eventually aim at providing a general, flexible, powerful and easy to use engine for drawing annotated heatmaps. The function \code{aheatmap} has many advantages compared to other heatmap functions such as \code{heatmap}, \code{gplots::heatmap2}, \code{heatmap.plus::heatmap.plus} , or even \code{pheatmap}: \begin{itemize} \item Annotations: unlimited number of annotation tracks can be added to \emph{both} columns and rows, with automated colouring for categorical and numeric variables. \item Compatibility with both base and grid graphics: the function can be directly called in drawing contexts such as grid, mfrow or layout. This is a feature many R users were looking for, and that was strictly impossible with base heatmaps. \item Legends: default automatic legend and colouring; \item Customisation: clustering methods, annotations, colours and legend can all be customised, even separately for rows and columns; \item Convenient interface: many arguments provide multiple ways of specifying their value(s), which speeds up developping/writing and reduce the amount of code required to generate customised plots (e.g. see \cref{sec:colour_spec}). \item Aesthetics: the heatmaps look globally cleaner, the image and text components are by default well proportioned relatively to each other, and all fit within the graphic device. \end{itemize} \subsection{Data and model} \label{sec:data} For the purpose of illustrating the use of each heatmap function, we generate a random target matrix, as well as some annotations or covariates: <>= # random data that follow an 3-rank NMF model (with quite some noise: sd=2) X <- syntheticNMF(100, 3, 20, noise=2) # row annotations and covariates n <- nrow(X) d <- rnorm(n) e <- unlist(mapply(rep, c('X', 'Y', 'Z'), 10)) e <- c(e, rep(NA, n-length(e))) rdata <- data.frame(Var=d, Type=e) # column annotations and covariates p <- ncol(X) a <- sample(c('alpha', 'beta', 'gamma'), p, replace=TRUE) # define covariates: true groups and some numeric variable c <- rnorm(p) # gather them in a data.frame covariates <- data.frame(a, X$pData, c) @ %\SweaveOpts{fig.width=14,fig.height=7} <>= library(knitr) opts_chunk$set(fig.width=14, fig.height=7) @ Note that in the code above, the object \code{X} returned by \code{syntheticNMF} \emph{really is} a matrix object, but wrapped through the function \code{ExposedAttribute} object, which exposes its attributes via a more friendly and access controlled interface \code{\$}. Of particular interests are attributes \code{'pData'} and \code{'fData'}, which are lists that contain a factor named \code{'Group'} that indicates the true underlying clusters. These are respectively defined as each sample's most contrbuting basis component and the basis component to which each feature contributes the most. They are useful to annotate heatmaps and assess the ability of NMF methods to recover the true clusters. As an example, one can conveniently visualize the target matrix as a heatmap, with or without the relevant sample and feature annotations, using simple calls to the \code{aheatmap} function: <>= par(mfrow=c(1,2)) aheatmap(X, annCol=covariates, annRow=X$fData) aheatmap(X) @ Then, we fit an NMF model using multiple runs, that will be used throughtout this vignette to illustrate the use of NMF heatmaps: <>= res <- nmf(X, 3, nrun=10) res @ \nbnote{To keep the vignette simple, we always use the default NMF method (i.e. \code{'brunet'}), but all steps could be performed using a different method, or multiple methods in order to compare their perfromances.} \section{Mixture Coefficient matrix: \texttt{coefmap}} The coefficient matrix of the result can be plotted using the function \code{coefmap}. The default behaviour for multiple NMF runs is to add two annotation tracks that show the clusters obtained by the best fit and the hierarchical clustering of the consensus matrix\footnote{The hierarchical clustering is computed using the consensus matrix itself as a similarity measure, and average linkage. See \code{?consensushc}.}. In the legend, these tracks are named \emph{basis} and \emph{consensus} respectively. For single NMF run or NMF model objects, no consensus data are available, and only the clusters from the fit are displayed. <>= opar <- par(mfrow=c(1,2)) # coefmap from multiple run fit: includes a consensus track coefmap(res) # coefmap of a single run fit: no consensus track coefmap(minfit(res)) par(opar) @ \nbnote{Note how both heatmaps were drawn on the same plot, simply using the standard call to \code{par(mfrow=c(1,2)}. This is impossible to achieve with the R core function \code{heatmap}. See \cref{sec:aheatmap} for more details about compatibility with base and grid graphics.} By default: \begin{itemize} \item the rows are not ordered; \item the columns use the default ordering of \code{aheatmap}, but may easily be ordered according to the clusters defined by the dominant basis component for each column with \code{Colv="basis"}, or according to those implied by the consensus matrix, i.e. as in \code{consensusmap}, with \code{Colv="consensus"}; \item each column is scaled to sum up to one; \item the color palette used is \code{'YlOrRd'} from the \citeCRANpkg{RColorBrewer}, with 50 breaks. \end{itemize} In term of arguments passed to the heatmap engine \code{aheatmap}, these default settings translate as: <>= Rowv = NA Colv = TRUE scale = 'c1' color = 'YlOrRd:50' annCol = predict(object) + predict(object, 'consensus') @ If the ordering does not come from a hierarchical clustering (e.g., if \code{Colv='basis'}), then no dendrogram is displayed. The default behaviour of \code{aheatmap} can be obtained by setting arguments \code{Rowv=TRUE, Colv=TRUE, scale='none'}. \medskip The automatic annotation tracks can be hidden all together by setting argument \code{tracks=NA}, displayed separately by passing only one of the given names (e.g. \code{tracks=':basis'} or \code{tracks='basis:'} for the row or column respectively), and their legend names may be changed by specifying e.g. \code{tracks=c(Metagene=':basis', 'consensus')}. Beside this, they are handled by the heatmap engine function \code{aheatmap} and can be customised as any other annotation tracks -- that can be added via the same argument \code{annCol} (see \cref{sec:aheatmap} or \code{?aheatmap} for more details). <>= opar <- par(mfrow=c(1,2)) # removing all automatic annotation tracks coefmap(res, tracks=NA) # customized plot coefmap(res, Colv = 'euclidean' , main = "Metagene contributions in each sample", labCol = NULL , annRow = list(Metagene=':basis'), annCol = list(':basis', Class=a, Index=c) , annColors = list(Metagene='Set2') , info = TRUE) par(opar) @ \nbnote{The feature that allows to display some information about the fit at the bottom of the plot via argument \code{info=TRUE} is still experimental. It is helpful mostly when developing algorithms or doing an analysis, but would seldom be used in publications.} \section{Basis matrix: \texttt{basismap}} The basis matrix can be plotted using the function \code{basismap}. The default behaviour is to add an annotation track that shows for each row the dominant basis component. That is, for each row, the index of the basis component with the highest loading. This track can be disabled by setting \code{tracks=NA}, and extra row annotations can be added using the same argument \code{annRow}. <>= opar <- par(mfrow=c(1,2)) # default plot basismap(res) # customized plot: only use row special annotation track. basismap(res, main="Metagenes", annRow=list(d, e), tracks=c(Metagene=':basis')) par(opar) @ By default: \begin{itemize} \item the columns are not ordered; \item the rows are ordered by hierarchical clustering using default distance and linkage methods (\code{'eculidean'} and \code{'complete'}); \item each row is scaled to sum up to one; \item the color palette used is \code{'YlOrRd'} from the \citeCRANpkg{RColorBrewer}, with 50 breaks. \end{itemize} In term of arguments passed to the heatmap engine \code{aheatmap}, these default settings translate as: <>= Colv = NA scale = 'r1' color = 'YlOrRd:50' annRow = predict(object, 'features') @ \section{Consensus matrix: \texttt{consensusmap}} When doing clustering with NMF, a common way of assessing the stability of the clusters obtained for a given rank is to consider the consensus matrix computed over multiple independent NMF runs, which is the average of the connectivity matrices of each separate run \footnote{Hence, stability here means robustness with regards to the initial starting point, and shall not be interpreted as in e.g. cross-validation/bootstrap analysis. However, one can argue that having very consistent clusters across runs somehow supports for a certain regularity or the presence of an underlying pattern in the data.}. This procedure is usually repeated over a certain range of factorization ranks, and the results are compared to identify which rank gives the best clusters, possibly in the light of some extra knowledge one could have about the samples (e.g. covariates). The functions \code{nmf} and \code{consensusmap} make it easy to implement this whole process. \nbnote{The consensus plots can also be generated for fits obtained from single NMF runs, in which case the consensus matrix simply reduces to a single connectivity matrix. This is a binary matrix (i.e. entries are either 0 or 1), that will always produce a bi-colour heatmap, and by default clear blocks for each cluster.} \subsection{Single fit} In section \cref{sec:data}, the NMF fit \code{res} was computed with argument \code{nrun=10}, and therefore contains the best fit over 10 runs, as well as the consensus matrix computed over all the runs \footnote{If one were interested in keeping the fits from all the runs, the function \code{nmf} should have been called with argument \code{.options='k'}. See section \emph{Options} in \code{?nmf}. The downstream hanlding of the result would remain identical.}. This can be ploted using the function \code{consensusmap}, which allows for the same kind of customization as the other NMF heatmap functions: <>= opar <- par(mfrow=c(1,2)) # default plot consensusmap(res) # customized plot consensusmap(res, annCol=covariates, annColors=list(c='blue') , labCol='sample ', main='Cluster stability' , sub='Consensus matrix and all covariates') par(opar) @ By default: \begin{itemize} \item the rows and columns of the consensus heatmap are symmetrically ordered by hierarchical clustering using the consensus matrix as a similarity measure and average linkage, and the associated dendrogram is displayed; \item the color palette used is the reverse of \code{'RdYlBu'} from the \citeCRANpkg{RColorBrewer}. \end{itemize} In term of arguments passed to the heatmap engine \code{aheatmap}, these default settings translate as: <>= distfun = function(x) as.dist(1-x) # x being the consensus matrix hclustfun = 'average' Rowv = TRUE Colv = "Rowv" color = '-RdYlBu' @ \subsection{Single method over a range of ranks} The function \code{nmf} accepts a range of value for the rank (argument \code{rank}), making it fit NMF models for each value in the given range \footnote{Before version 0.6, this feature was provided by the function \code{nmfEstimateRank}. From version 0.6, the function \code{nmf} accepts ranges of ranks, and internally calls the function \code{nmfEstimateRank} -- that remains exported and can still be called directly. See documentation \code{?nmfEstimateRank} for more details on the returned value.}: <>= res2_7 <- nmf(X, 2:7, nrun=10, .options='v') class(res2_7) @ The result \code{res2\_7} is an S3 object of class \code{'NMF.rank'}, that contains -- amongst other data -- a list of the best fits obtained for each value of the rank in range $\ldbrack 2, 7\rdbrack]$. The method of \code{consensusmap} defined for class \code{'NMF.rank'}, which plots all the consensus matrices on the same plot: <>= consensusmap(res2_7) @ \nbnote{ The main title of each consensus heatmap can be customized by passing to argument \code{main} a character vector or a list whose elements specify each title. All other arguments are used in each internal call to consensusmap, and will therefore affect all the plots simultaneously. The layout can be specified via argument \code{layout} as a numeric vector giving the number of rows and columns in a \code{mfrow}-like way, or as a matrix that will be passed to R core function \code{layout}. See \code{?consensusmap} for more details and example code. } \subsection{Single rank over a range of methods} If one is interested in comparing methods, for a given factorization rank, then on can fit an NMF model for each method by providing the function \code{nmf} with a \code{list} in argument \code{method}: <>= res_methods <- nmf(X, 3, list('lee', 'brunet', 'nsNMF'), nrun=10) class(res_methods) @ The result \code{res\_methods} is an S4 object of class \code{NMFList}, which is essentially a named list, that contains each fits and the CPU time required by the whole computation. As previously, the sequence of consensus matrices is plotted with \code{consensusmap}: <>= consensusmap(res_methods) @ \section{Generic heatmap engine: \texttt{aheatmap}} \label{sec:aheatmap} This section still needs to be written, but many examples of annotated heatmaps can be found in the demos \code{'aheatmap'} and \code{'heatmaps'}: <>= demo('aheatmap') # or demo('heatmaps') @ These demos and the plots they generate can also be browsed online at \url{http://nmf.r-forge.r-project.org/_DEMOS.html}. \section{Session Info} <>= toLatex(sessionInfo()) @ \printbibliography[heading=bibintoc] \end{document} NMF/inst/doc/NMF-unitTests.Rnw0000644000176000001440000002025012311534443015553 0ustar ripleyusers \documentclass[10pt]{article} %\VignetteDepends{knitr} %\VignetteIndexEntry{NMF-unitTests} %\VignetteCompiler{knitr} %\VignetteEngine{knitr::knitr} \usepackage{vmargin} \setmargrb{0.75in}{0.75in}{0.75in}{0.75in} <>= pkg <- 'NMF' require( pkg, character.only=TRUE ) prettyVersion <- packageDescription(pkg)$Version prettyDate <- format(Sys.Date(), '%B %e, %Y') authors <- packageDescription(pkg)$Author @ \usepackage[colorlinks]{hyperref} \author{\Sexpr{authors}} \title{\texttt{\Sexpr{pkg}}: Unit testing results\footnote{Vignette computed on Tue Mar 4 13:14:49 2014}} \date{\texttt{\Sexpr{pkg}} version \Sexpr{prettyVersion} as of \Sexpr{prettyDate}} \begin{document} \maketitle \section{Details} \begin{verbatim} RUNIT TEST PROTOCOL -- Tue Mar 4 13:14:49 2014 *********************************************** Number of test functions: 81 Number of deactivated test functions: 5 Number of errors: 0 Number of failures: 0 1 Test Suite : package:NMF - 81 test functions, 0 errors, 0 failures Details *************************** Test Suite: package:NMF Test function regexp: ^test. Test file regexp: ^runit.*.[rR]$ Involved directory: /tmp/Rpkglib_26ff65706d7b/NMF/tests --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.aheatmap.R test.mfrow: (1 checks) ... OK (0.69 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.algorithms.r test.brunet: (16 checks) ... OK (4.22 seconds) test.cversions.brunet: (1 checks) ... OK (0.87 seconds) test.cversions.lee: (1 checks) ... OK (1.03 seconds) test.cversions.lnmf : DEACTIVATED, Algorithm 'lnmf' is not fully working. test.cversions.ns: (1 checks) ... OK (1.11 seconds) test.cversions.offset: (1 checks) ... OK (2.19 seconds) test.frobenius: (16 checks) ... OK (5.38 seconds) test.KL: (16 checks) ... OK (4.23 seconds) test.lee: (16 checks) ... OK (3.72 seconds) test.lnmf : DEACTIVATED, Algorithm 'lnmf' is not fully working. test.ns: (16 checks) ... OK (3.78 seconds) test.offset: (16 checks) ... OK (3.97 seconds) test.port_brunet : DEACTIVATED, Package RcppOctave not available. test.snmf: (44 checks) ... OK (9.39 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.bioc.r test.access: (26 checks) ... OK (0.02 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.distance.r test.KL: (9 checks) ... OK (1.44 seconds) test.rss: (4 checks) ... OK (0.06 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.interface.r test.compare: (5 checks) ... OK (9.3 seconds) test.nmf.callback: (22 checks) ... OK (13.81 seconds) test.nmf.custom: (87 checks) ... OK (1.5 seconds) test.nmf.default: (8 checks) ... OK (0.23 seconds) test.nmf.dots: (11 checks) ... OK (0.84 seconds) test.nmf.method: (36 checks) ... OK (10.79 seconds) test.nmf.model: (22 checks) ... OK (0.62 seconds) test.nmfModel.formula: (12 checks) ... OK (0.92 seconds) test.nmf.multirank: (10 checks) ... OK (5.68 seconds) test.nmf.options: (18 checks) ... OK (5.44 seconds) test.nmf.parameters: (53 checks) ... OK (0.81 seconds) test.nmf.seed.argument: (149 checks) ... OK (9.4 seconds) test.nmf.seed.equivalent: (11 checks) ... OK (10.82 seconds) test.nmf.seed.fault: (4 checks) ... OK (2.9 seconds) test.nmf.seed.repro: (8 checks) ... OK (14.43 seconds) test.nmf.stop: (6 checks) ... OK (2.17 seconds) test.parallel: (6 checks) ... OK (12.28 seconds) test.registry: (9 checks) ... OK (0.13 seconds) test.seed: (33 checks) ... OK (0.13 seconds) test.summary: (3 checks) ... OK (2.86 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.NMFclass.r test.basis: (2 checks) ... OK (0.01 seconds) test.class.NMFns: (65 checks) ... OK (0.03 seconds) test.class.NMFstd: (28 checks) ... OK (0.01 seconds) test.coef: (2 checks) ... OK (0 seconds) test.connectivity: (3 checks) ... OK (0.01 seconds) test.deviance: (9 checks) ... OK (0.02 seconds) test.dimensions: (4 checks) ... OK (0 seconds) test.dimnames: (173 checks) ... OK (0.08 seconds) test.entropy: (5 checks) ... OK (0 seconds) test.misc: (9 checks) ... OK (0 seconds) test.nmfModel: (363 checks) ... OK (0.11 seconds) test.NMF.rnmf: (93 checks) ... OK (1.5 seconds) test.predict: (10 checks) ... OK (0.01 seconds) test.purity: (5 checks) ... OK (0 seconds) test.sparseness: (13 checks) ... OK (0.01 seconds) test.subset: (50 checks) ... OK (0.05 seconds) test.syntheticNMF: (5 checks) ... OK (1.62 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.NMFfit-class.r test.deviance: (0 checks) ... OK (0 seconds) test.isNMFfit: (6 checks) ... OK (3.59 seconds) test.niter: (4 checks) ... OK (1.1 seconds) test.nmf.equal: (304 checks) ... OK (1.87 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.NMFSet.r test.fit: (9 checks) ... OK (3.85 seconds) test.interface: (6 checks) ... OK (1.86 seconds) test.join.multipleAndSingleRunsMethods: (2 checks) ... OK (3.32 seconds) test.join.multipleRuns: (2 checks) ... OK (4.6 seconds) test.join.singleRuns: (7 checks) ... OK (0.7 seconds) test.multipleruns: (2 checks) ... OK (1.7 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.NMFStrategy-class.r test.accessors: (26 checks) ... OK (0.06 seconds) test.constructor: (16 checks) ... OK (0.06 seconds) test.constructorMethod: (3 checks) ... OK (0.04 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.options.r test.nmf.getOption: (2 checks) ... OK (0 seconds) test.nmf.options: (9 checks) ... OK (0 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.parallel.r test.ForeachBackend: (4 checks) ... OK (1.37 seconds) test.gVariable: (11 checks) ... OK (10.16 seconds) test.nmf: (59 checks) ... OK (41.99 seconds) test.setupBackend: (4 checks) ... OK (0.05 seconds) test.shared_memory_doMC: (12 checks) ... OK (6.1 seconds) test.shared_memory_doMPI : DEACTIVATED, NMF shared memory feature does not currently work with doMPI. test.shared_memory_doParallel: (12 checks) ... OK (10.88 seconds) test.shared_memory_doSEQ: (11 checks) ... OK (6.46 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.seed.r test.nndsvd: (10 checks) ... OK (0.04 seconds) test.none: (6 checks) ... OK (0.03 seconds) test.random: (26 checks) ... OK (0.13 seconds) test.restore : DEACTIVATED, The option 'restore.seed' is deprecated. Related tests are now in test.seed.effect test.seed.effect: (15 checks) ... OK (16.37 seconds) test.zzz.all: (297 checks) ... OK (16.42 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.utils.r test.nmfWrapper: (16 checks) ... OK (0.85 seconds) test.rmatrix: (16 checks) ... OK (0.01 seconds) Total execution time *************************** user system elapsed 253.753 31.645 293.297 \end{verbatim} \section*{Session Information} \begin{itemize}\raggedright \item R Under development (unstable) (2014-03-02 r65102), \verb|x86_64-unknown-linux-gnu| \item Locale: \verb|LC_CTYPE=en_US.UTF-8|, \verb|LC_NUMERIC=C|, \verb|LC_TIME=en_US.UTF-8|, \verb|LC_COLLATE=en_US.UTF-8|, \verb|LC_MONETARY=en_US.UTF-8|, \verb|LC_MESSAGES=en_US.UTF-8|, \verb|LC_PAPER=en_US.UTF-8|, \verb|LC_NAME=C|, \verb|LC_ADDRESS=C|, \verb|LC_TELEPHONE=C|, \verb|LC_MEASUREMENT=en_US.UTF-8|, \verb|LC_IDENTIFICATION=C| \item Base packages: base, datasets, graphics, grDevices, methods, parallel, stats, utils \item Other packages: BH~1.51.0-4, bigmemory~4.4.6, bigmemory.sri~0.1.2, Biobase~2.22.0, BiocGenerics~0.8.0, cluster~1.14.4, doMPI~0.2, doParallel~1.0.8, fastICA~1.2-0, foreach~1.4.1, iterators~1.0.6, NMF~0.20.2, pkgmaker~0.17.4, RColorBrewer~1.0-5, Rcpp~0.11.0, registry~0.2, Rmpi~0.6-3, rngtools~1.2.3, RUnit~0.4.26, stringr~0.6.2, synchronicity~1.1.2 \item Loaded via a namespace (and not attached): codetools~0.2-8, colorspace~1.2-4, compiler~3.1.0, dichromat~2.0-0, digest~0.6.4, ggplot2~0.9.3.1, grid~3.1.0, gridBase~0.4-7, gtable~0.1.2, labeling~0.2, MASS~7.3-29, munsell~0.4.2, plyr~1.8.1, proto~0.3-10, reshape2~1.2.2, scales~0.2.3, tools~3.1.0, xtable~1.7-1 \end{itemize} \end{document} NMF/inst/doc/NMF-vignette.R0000644000176000001440000003356212311534443015043 0ustar ripleyusers ## ----pkgmaker_preamble, echo=FALSE, results='asis'----------------------- pkgmaker::latex_preamble() ## ----bibliofile, echo=FALSE, results='asis'------------------------------ pkgmaker::latex_bibliography('NMF') ## ----options, echo=FALSE------------------------------------------------- set.seed(123456) library(knitr) knit_hooks$set(try = pkgmaker::hook_try, backspace = pkgmaker::hook_backspace()) ## ----load_library, echo=FALSE, include=FALSE----------------------------- # Load library(NMF) # limit number of cores used nmf.options(cores = 2) ## ----load_library_fake, eval=FALSE--------------------------------------- ## # Install ## install.packages('NMF') ## # Load ## library(NMF) ## ----updateObject, eval=FALSE-------------------------------------------- ## # eg., load from some RData file ## load('object.RData') ## # update class definition ## object <- nmfObject(object) ## ----features, echo=FALSE------------------------------------------------ nalgo <- length(nmfAlgorithm()) nseed <- length(nmfSeed()) ## ----nmfAlgorithm-------------------------------------------------------- # list all available algorithms nmfAlgorithm() # retrieve a specific algorithm: 'brunet' nmfAlgorithm('brunet') # partial match is also fine identical(nmfAlgorithm('br'), nmfAlgorithm('brunet')) ## ----nmfSeed------------------------------------------------------------- # list all available seeding methods nmfSeed() # retrieve a specific method: 'nndsvd' nmfSeed('nndsvd') # partial match is also fine identical(nmfSeed('nn'), nmfSeed('nndsvd')) ## ----show_Rversions------------------------------------------------------ nmfAlgorithm(all=TRUE) # to get all the algorithms that have a secondary R version nmfAlgorithm(version='R') ## ----perftable_setup, cache=TRUE----------------------------------------- # retrieve all the methods that have a secondary R version meth <- nmfAlgorithm(version='R') meth <- c(names(meth), meth) meth # load the Golub data data(esGolub) # compute NMF for each method res <- nmf(esGolub, 3, meth, seed=123456) # extract only the elapsed time t <- sapply(res, runtime)[3,] ## ----perftable, echo=FALSE, results='asis'------------------------------- # speed-up m <- length(res)/2 su <- cbind( C=t[1:m], R=t[-(1:m)], Speed.up=t[-(1:m)]/t[1:m]) library(xtable) xtable(su, caption='Performance speed up achieved by the optimized C++ implementation for some of the NMF algorithms.', label='tab:perf') ## ----citations, eval=FALSE----------------------------------------------- ## # plain text ## citation('NMF') ## ## # or to get the bibtex entries ## toBibtex(citation('NMF')) ## ----esGolub------------------------------------------------------------- data(esGolub) esGolub esGolub <- esGolub[1:200,] # remove the uneeded variable 'Sample' from the phenotypic data esGolub$Sample <- NULL ## ----algo_default, cache=TRUE-------------------------------------------- # default NMF algorithm res <- nmf(esGolub, 3) ## ----single_show--------------------------------------------------------- res ## ----single_show_model--------------------------------------------------- fit(res) ## ----single_show_estimate------------------------------------------------ V.hat <- fitted(res) dim(V.hat) ## ----singlerun_summary--------------------------------------------------- summary(res) # More quality measures are computed, if the target matrix is provided: summary(res, target=esGolub) ## ----singlerun_summary_factor-------------------------------------------- summary(res, class=esGolub$Cell) ## ----get_matrices-------------------------------------------------------- # get matrix W w <- basis(res) dim(w) # get matrix H h <- coef(res) dim(h) ## ----subset-------------------------------------------------------------- # keep only the first 10 features res.subset <- res[1:10,] class(res.subset) dim(res.subset) # keep only the first 10 samples dim(res[,1:10]) # subset both features and samples: dim(res[1:20,1:10]) ## ----single_extract------------------------------------------------------ # only compute the scores s <- featureScore(res) summary(s) # compute the scores and characterize each metagene s <- extractFeatures(res) str(s) ## ----algo_list----------------------------------------------------------- nmfAlgorithm() ## ----algo_lee, cache=TRUE------------------------------------------------ # using Lee and Seung's algorithm res <- nmf(esGolub, 3, 'lee') algorithm(res) ## ----algo_ns, cache=TRUE------------------------------------------------- # using the Nonsmooth NMF algorithm with parameter theta=0.7 res <- nmf(esGolub, 3, 'ns', theta=0.7) algorithm(res) fit(res) ## ----algo_pe, cache=TRUE------------------------------------------------- # using the PE-NMF algorithm with parameters alpha=0.01, beta=1 res <- nmf(esGolub, 3, 'pe', alpha=0.01, beta=1) res ## ----seed_list----------------------------------------------------------- nmfSeed() ## ----seed, cache=TRUE---------------------------------------------------- res <- nmf(esGolub, 3, seed='nndsvd') res ## ----seed_numeric, cache=TRUE-------------------------------------------- # single run and single numeric seed res <- nmf(esGolub, 3, seed=123456) showRNG(res) # multiple runs and single numeric seed res <- nmf(esGolub, 3, seed=123456, nrun=2) showRNG(res) # single run with a 6-length seed res <- nmf(esGolub, 3, seed=rep(123456, 6)) showRNG(res) ## ----seed_WH------------------------------------------------------------- # initialize a "constant" factorization based on the target dimension init <- nmfModel(3, esGolub, W=0.5, H=0.3) head(basis(init)) # fit using this NMF model as a seed res <- nmf(esGolub, 3, seed=init) ## ----algo_multirun, cache=TRUE------------------------------------------- res.multirun <- nmf(esGolub, 3, nrun=5) res.multirun ## ----multirun_keep, cache=TRUE------------------------------------------- # explicitly setting the option keep.all to TRUE res <- nmf(esGolub, 3, nrun=5, .options=list(keep.all=TRUE)) res ## ----multirun_keep_alt, eval=FALSE--------------------------------------- ## # or using letter code 'k' in argument .options ## nmf(esGolub, 3, nrun=5, .options='k') ## ----parallel_multicore_alt, eval=FALSE---------------------------------- ## # the default call will try to run in parallel using all the cores ## # => will be in parallel if all the requirements are satisfied ## nmf(esGolub, 3, nrun=5, .opt='v') ## ## # request a certain number of cores to use => no error if not possible ## nmf(esGolub, 3, nrun=5, .opt='vp8') ## ## # force parallel computation: use option 'P' ## nmf(esGolub, 3, nrun=5, .opt='vP') ## ## # require an improbable number of cores => error ## nmf(esGolub, 3, nrun=5, .opt='vP200') ## ----mpi, eval=FALSE----------------------------------------------------- ## # file: mpi.R ## ## ## 0. Create and register an MPI cluster ## library(doMPI) ## cl <- startMPIcluster() ## registerDoMPI(cl) ## library(NMF) ## ## # run on all workers using the current parallel backend ## data(esGolub) ## res <- nmf(esGolub, 3, 'brunet', nrun=n, .opt='p', .pbackend=NULL) ## ## # save result ## save(res, file='result.RData') ## ## ## 4. Shutdown the cluster and quit MPI ## closeCluster(cl) ## mpi.quit() ## ## ----force_seq, cache=TRUE, backspace = TRUE----------------------------- # parallel execution on 2 cores (if possible) res1 <- nmf(esGolub, 3, nrun=5, .opt='vp2', seed=123) # or use the doParallel with single core res2 <- nmf(esGolub, 3, nrun=5, .opt='vp1', seed=123) # force sequential computation by sapply: use option '-p' or .pbackend=NA res3 <- nmf(esGolub, 3, nrun=5, .opt='v-p', seed=123) res4 <- nmf(esGolub, 3, nrun=5, .opt='v', .pbackend=NA, seed=123) # or use the SEQ backend of foreach: .pbackend='seq' res5 <- nmf(esGolub, 3, nrun=5, .opt='v', .pbackend='seq', seed=123) # all results are all identical nmf.equal(list(res1, res2, res3, res4, res5)) ## ----estimate_rank, cache=TRUE------------------------------------------- # perform 10 runs for each value of r in range 2:6 estim.r <- nmf(esGolub, 2:6, nrun=10, seed=123456) ## ----estimate_rank_plot, fig.width=10, fig.height=6---------------------- plot(estim.r) ## ----estimate_rank_hm_include, fig.width=14, fig.height=7, fig.keep='last'---- consensusmap(estim.r, annCol=esGolub, labCol=NA, labRow=NA) ## ----estimate_rank_random, cache=TRUE, fig.width=10, fig.height=6, fig.keep='last'---- # shuffle original data V.random <- randomize(esGolub) # estimate quality measures from the shuffled data (use default NMF algorithm) estim.r.random <- nmf(V.random, 2:6, nrun=10, seed=123456) # plot measures on same graph plot(estim.r, estim.r.random) ## ----multimethod, cache=TRUE--------------------------------------------- # fit a model for several different methods res.multi.method <- nmf(esGolub, 3, list('brunet', 'lee', 'ns'), seed=123456, .options='t') ## ----compare------------------------------------------------------------- compare(res.multi.method) # If prior knowledge of classes is available compare(res.multi.method, class=esGolub$Cell) ## ----errorplot_compute, cache=TRUE--------------------------------------- # run nmf with .option='t' res <- nmf(esGolub, 3, .options='t') # or with .options=list(track=TRUE) ## ----errorplot, out.width="0.5\\textwidth", fig.show='hold'-------------- plot(res) plot(res.multi.method) ## ----heatmap_coef_basis_inc, fig.width=14, fig.height=7, fig.keep='last'---- layout(cbind(1,2)) # basis components basismap(res, subsetRow=TRUE) # mixture coefficients coefmap(res) ## ----heatmap_consensus_inc, out.width="0.49\\textwidth", crop=TRUE, echo=1:2---- # The cell type is used to label rows and columns consensusmap(res.multirun, annCol=esGolub, tracks=NA) plot(1:10) f2 <- fig_path("2.pdf") ## ----hack_consensus, include=FALSE--------------------------------------- file.copy('consensus.pdf', f2, overwrite=TRUE) ## ----custom_algo_sig----------------------------------------------------- my.algorithm <- function(x, seed, param.1, param.2){ # do something with starting point # ... # return updated starting point return(seed) } ## ----custom_algo--------------------------------------------------------- my.algorithm <- function(x, seed, scale.factor=1){ # do something with starting point # ... # for example: # 1. compute principal components pca <- prcomp(t(x), retx=TRUE) # 2. use the absolute values of the first PCs for the metagenes # Note: the factorization rank is stored in object 'start' factorization.rank <- nbasis(seed) basis(seed) <- abs(pca$rotation[,1:factorization.rank]) # use the rotated matrix to get the mixture coefficient # use a scaling factor (just to illustrate the use of extra parameters) coef(seed) <- t(abs(pca$x[,1:factorization.rank])) / scale.factor # return updated data return(seed) } ## ----define_V------------------------------------------------------------ n <- 50; r <- 3; p <- 20 V <-syntheticNMF(n, r, p) ## ----custom_algo_run----------------------------------------------------- nmf(V, 3, my.algorithm, scale.factor=10) ## ----custom_algo_run_obj------------------------------------------------- # based on Kullback-Leibler divergence nmf(V, 3, my.algorithm, scale.factor=10, objective='KL') # based on custom distance metric nmf(V, 3, my.algorithm, scale.factor=10 , objective=function(model, target, ...){ ( sum( (target-fitted(model))^4 ) )^{1/4} } ) ## ----custom_algo_run_mixed, error = TRUE, try = TRUE--------------------- # put some negative input data V.neg <- V; V.neg[1,] <- -1; # this generates an error try( nmf(V.neg, 3, my.algorithm, scale.factor=10) ) # this runs my.algorithm without error nmf(V.neg, 3, my.algorithm, mixed=TRUE, scale.factor=10) ## ----nmf_models---------------------------------------------------------- nmfModel() ## ----custom_algo_NMFoffset----------------------------------------------- my.algorithm.offset <- function(x, seed, scale.factor=1){ # do something with starting point # ... # for example: # 1. compute principal components pca <- prcomp(t(x), retx=TRUE) # retrieve the model being estimated data.model <- fit(seed) # 2. use the absolute values of the first PCs for the metagenes # Note: the factorization rank is stored in object 'start' factorization.rank <- nbasis(data.model) basis(data.model) <- abs(pca$rotation[,1:factorization.rank]) # use the rotated matrix to get the mixture coefficient # use a scaling factor (just to illustrate the use of extra parameters) coef(data.model) <- t(abs(pca$x[,1:factorization.rank])) / scale.factor # 3. Compute the offset as the mean expression data.model@offset <- rowMeans(x) # return updated data fit(seed) <- data.model seed } ## ----custom_algo_NMFOffset_run------------------------------------------- # run custom algorithm with NMF model with offset nmf(V, 3, my.algorithm.offset, model='NMFOffset', scale.factor=10) ## ----custom_seed--------------------------------------------------------- # start: object of class NMF # target: the target matrix my.seeding.method <- function(model, target){ # use only the largest columns for W w.cols <- apply(target, 2, function(x) sqrt(sum(x^2))) basis(model) <- target[,order(w.cols)[1:nbasis(model)]] # initialize H randomly coef(model) <- matrix(runif(nbasis(model)*ncol(target)) , nbasis(model), ncol(target)) # return updated object return(model) } ## ----custom_seed_run----------------------------------------------------- nmf(V, 3, 'snmf/r', seed=my.seeding.method) ## ----options_algo, eval=1:6---------------------------------------------- #show default algorithm and seeding method nmf.options('default.algorithm', 'default.seed') # retrieve a single option nmf.getOption('default.seed') # All options nmf.options() ## ----nmf_options, echo=FALSE, results='asis'----------------------------- RdSection2latex('nmf.options', package='NMF') ## ----print_options------------------------------------------------------- nmf.printOptions() ## ----sessionInfo, echo=FALSE, results='asis'----------------------------- toLatex(sessionInfo()) NMF/inst/doc/NMF-unitTests.R0000644000176000001440000000041112311534443015203 0ustar ripleyusers ## ----setup, include=FALSE------------------------------------------------ pkg <- 'NMF' require( pkg, character.only=TRUE ) prettyVersion <- packageDescription(pkg)$Version prettyDate <- format(Sys.Date(), '%B %e, %Y') authors <- packageDescription(pkg)$Author NMF/inst/doc/NMF-unitTests.pdf0000644000176000001440000031626312305630424015571 0ustar ripleyusers%PDF-1.5 % 9 0 obj << /Length 1005 /Filter /FlateDecode >> stream xW[s:~W B--MNz =K1F7BVM: 3xVӷw Z +7zMf BBZؑ.{ |OW`T)C$*̬Py% #d*/"7fEb9f0(َFtvUTH,`mhqL-i*90.bzoU-6+2,)2 6?wư݆fUGib f3s?7ih~h37>[h躘q2޿TŕK,XHb)І8 ~CFzq:&FKe&pz%m@1Ƕ4)h(.f\Tf`/s2 >6K1W>?gkSeY5ȱBc o>HrWmԫxlx[FEqD6!:)g  y osMd]B1RfŪmkVՆ_lzbDdƛ&Q"~FgT֣aGLsg6z#}VG~'U9zdK+m+W,} ۡN`jcl&w?u 푫 MFű1xfQ\8{ tUK\t`nc~|+ؘOLނݮs hԉ'!&٪»|]]yrKf%͘[!c=@er(O@w= 3LTi̱. _A4hݰd{gfWs=ۏ04X'Aoԁ? %,VxPz(LFH) V{? Q Ti8s[XB-> stream xX]o0}߯xc;Đ r/lg=n3]n7jҤJs|=^d~~H2':YrIVU)EN8njMV;!=Bhretgjz_T+齵nRnOK̫:|snԌvh{̡ )g1I8W:Ius LUuJ:}\hU^o)Ҿ ڽNIcuGGu*kaPHYN4곁 POddӔ2;׌4UivW(a4q*Iw Vu 9oqmUCه*Ha-r~ܤydfrH064$";3΋)#q,20Zhlƽ endstream endobj 28 0 obj << /Length 1297 /Filter /FlateDecode >> stream xX[sF~:֢^$u&t2m#K #'G 7ac`8|羻2[zf ; "[ZlG?O/Wb`\/ 1ڳ8?eW.Waw8MѠ+AeKTHoS]Y,?Mfj.DPhZ|x%a*D߅R 54 #whY&2^%F8'bRHE5+F>k|5uo ni"xȍ.#y &AQi EQdF!7Pfy . zK7l%cpO ͅY3X Q'h yAdOY.pq"Wm4OH6qp7'7%m 5I*]UTY^Jh|r-2˿E٨_i^vٜ͵& XfCM1{ozbIHƽ7yJAiS)h]^N V<߻ƿ@aA6P7zۉ7qz%h?V#dϑj譂c`.w =0+(@BsإqH bzRnI 5><3e)1:rtۑg<\ endstream endobj 33 0 obj << /Length 661 /Filter /FlateDecode >> stream xڕTr +D3$8Ӥ4m&qWMX"2$4>!ds=gIdYޜ]\Ԩ.IlrjJ*/PIqio)U}1]\JܯϹ_̎yF֤d^ҢӻRJ SQQފ{gB+ ФFd^ eARl#)c47|Z4ʥXVvr13ha;ҪUw< ޱdIef/g6۫Ў0سohJ Qz:4,8<Ɨg/'▕bTzL'J`=4l0杘L갋~ڔ0_nS y0"RB\p)egwYVhl3t5DO<!_wX[S0?|/aSVdlh}ʠe,NK)@Vix,DnD/Z̄7E¾^sX{x]7JeHFyoE{:X0YБ*-vG{ϨPI@aRF~hU0jsgvl$pj&xBߑ~ %*:efROߜ.|hf endstream endobj 44 0 obj << /Length1 1599 /Length2 8174 /Length3 0 /Length 9209 /Filter /FlateDecode >> stream xڍT5 ҍtH7HwH, !!HIHw(%HJ( /g;sgyDw$/-1 92Hc?}i6WEv,N_d⎖pͲf[ݗ;p ;+nseL')ne,Qkg;Jvd:aȈ7% Ы|Nh3}FѺ_쫕LhE>~CRU>aUQ.1K)?bI7R/᢭ |FΚ%h}?Xϛnӻ`-5U3]B.I}M&XSp[RR(Ƴ2_oLݑ$=]N^zfe=K&TFZli?|'RtЛ:o@ N+ JOKU2:02 XL1Sx swVJVS ѩJ$4LCf6rn _Hòbt S##kB4\tѢϾn Z^C Ps3mznp>&dUvcHGp\d } '͞_ӖGðˊ$e<dgwq#xCa`$k?H$)e{<:lz" g*iUSf ZiՄ{M yAƞggvj(+/B@Y·,NvɶQ7EzE^w%pf oRD&-27Ou:[fK3Nʗ:Ÿ  h>׾R1K6d%*i+:WUif:yjC:hJ}?\^M] Z维2r|lM䪃-qcJRSFMEc?>oKrɄm^f jRKY /ɏ%_ӷ@wNfuOd<oO~v!Y%ek{%IWEm/6#d.Z*FΜ\9 =ӄFR)k< {uUYWpaz r M-us/j''dBF?|틁O FyH:R gvԫֈ$ИnMj֥+`amz9Q /-IE_Cgx\m{, -dsۙ.Eɟy;u?F[|;K5 -ɦB[Дk?ĠI{)NǙPRvɿeHcTj`P@l߈+ ~q0T|ci7 XqvMeEV3RGvl($`ݙdL\ɄμD@X:Rú PBcLsWax-9U6-[e֗e[iLttQ4S)kPh z)!U'mhw4Mr-%thP\|guEǾ2mKJ׮:tAyd'=ŵ 9l]=k-~.<,%Ʉc|Xn w`4hnUC:g"5_l kɗN'n h872?:Uk8sW3ڏ`=*vs5^Rm_#w'_'?eGOc=i<4eHC_+1 [S*K.HrmW n8Vw{#dHtM)!/lE/QZT;?uDK);>lj~v{Yqrm`k4߭ yU`줃Pj3V`V=$ߓyI]RpE+EosY/|&e笢s@s 6]:;ذ.4jƌ~'IAq?iQ8kP!䕮 GFE͌`i= z=*=`;joerI&,Y"})_dX=y{$AC{{`Ode6Ucu~^7;*O0كm݁5\mU xp܉ 3\]ffVT8xS>t+6 c.v *߂ƵsǨԱJs8GFT 8]S6A.*ߥF'&zRU%^e,:X%">ג hp,ưVJ%; ~LP R+<}Y(O'a(psSx*B98B KRMcZ[qó,NU+#^pi1 z|(L"~?:HNO 2u7e^ u5}_fm}/04&7+u3 H#M5x ӫ2ڎ2ӧ,,tuaBc AȐԣBE s^CVϊ}~~pbn Z\:sǑIsz[G?VFklhΓЉԫw0k_h ˼ܥãS:%q-{W{I' 檁h5/v##7!fd9pA)56 YTM6Nd*5]v%lQOqo8T+e$1_2Jj5 SsZ0gB@_K}ȏ ]g|uT냚+⍊2L2 ÀYPe(-{ŭi|VG'Ss]t=ԧ-I'ɉuž !方q8_8[5K.O4lAʌ ukD!:ZRD@*5%8xF}G#LX-r:qkg5߶U{Ddt/5K `frT^F=CӦוU?fZo;1AI96 l2 ' d|<}A` 4KۢʖQ1&:[;?u18R>sXoHg4'\L^7h33a互̗pdL]ꍯ]9(zw{["(*RdQѨb<=v*@z4"2̢h\m** 󾳏J>25Hw^񳹱3ǗuF+MEa?}qqʦj1[UyWbkZ[}~QB6#ū(LPr1{̽eMqN'N­mԱS6<| LՁɄ].ќgdQ "z`屙zkcR `ڷn֍oH"2tuxkq]Q{35%z2tSfd~S{"˫Z-F{>2s4yfQsq|! y_M*4G9໇xƾ(H:~g,t @: Iܤ$6Ĝ@ITKFPv{|DeLzJq,CzZa{J+:*1įٷX`@,أ4LEy3ooA':فFl{2(̡I|Q@MQiև쎽EA凵j<~2]̨nx1clku.ɏKN 4ml-_f%AHTݱdإ.`؈SOzMɎ f3p}虡 ߖQwx _CRǛNB򛢓źԳ/ӜSTUJӏyDQեuxqKv%dhk#5X}Yӭ8WP*Aˊ23l2  fi4hUœąH=HG@r{MG o$KǖiFnk)P3x=9_m&MzZ4-إfV"YI㏩]{a~Q8ML=MkVӕqP,VqqiMyXrdq{"|7UJi"bt %4Pӭh-)2 8o0BLûQsFh,y'LñCz?ox s\ bO8U~0[ifC+^~I$lݙo]|ڏGD+GeOYܝja&KYp 7ݽgwǓ>N*pk:3 FnԕZ_8-Y;ւO~N+` Ug]Puϼv=Xrˀvm J4<懗{X1oƖxjgӥ DT,Qsz=vLmǕ B$2/)S+OI]?1_'ur}cVa*[$5g+(+\+ƞ%Xʧ!¬,'oAZK8 |N6 WϷ*69UӮ*>2%,q4|5!眤~YK-Mqq=1!Oi#@H 쵝Jm"Œcj k `2\O/+rUmn g'rX6k7u=-ja^ ~V,Y0jxo>u".GrOi}"LuMҬj@TuDCF=T0\vϯ35XB{l.>="-ZhZ{d'9kfޑJ?2G}Q8K*UΤQ;|}g<4x%pdJ5S4&ऻHDU+SF]++o4;tOcI4٦ $ ^dT;W?HUp<>MDWeԌo\M>볏a^]=v|r>L&Rpq9HwB#Ƞ {V3P=UlJF̆1Q-5wWg5d>!&ozL*y}/$=-j/=R7F=,[^Q}&5* Oȡ7|'h̡C,&a^;\/^A2/ l !CSq״y@d,2_69@3_"+nmenRi2Zg$eO(QNHtp OjJBiv)5{ N筌?E8Vլ\S/aد\E|_r'{K {"aO6d.:7 dѐ@> §_lѲ27Y&D6<oWU1j%+Ԅ83fą7;lCnzt]K7Fhc6)6hd9r=ysvٕ)sqj}Һ'NAy]y3*^8+e endstream endobj 46 0 obj << /Length1 2226 /Length2 18356 /Length3 0 /Length 19679 /Filter /FlateDecode >> stream xڌtk l4ضm76'mi6ۍ6xs΃}kf~!#RT23:13rD01YT,Ñ,la 4t:]L,&vn&nFF3## &9z- L#T&..ڿB6@G cC[9#5@?!(y͝ mhn/@'+a _*N+ۙ::k cӇ ,% PX_Dp+Άv6fS k @A\ݙ`hk򗡡݇чߕąMى/ 貘 D-m`ZڹzZؚEŞA(%o: WdK`Aca r2t]>^T/cbX;fphf=&_>~ϗARDDDE_sxѱ2L ǃoCoſGD)[S;׿8|4?<\=^*fe 011^]_QF$bmorvaMՁZe9J9~h$n4Qp66 >[[,ltt glq8}*>oJ1[c;`hq &@G@ok0sD B A0q0 &1 A }d>2A\"Ώ|G/G?胑G?#Cglgq% 1~_P?Z/?>L?J0S5s{s?,>d|?HY~0?.?>\m?zv8z?`0@?`e*G3>LĜ9ۇ# W #(]?zAdG2|z7- y-k>͐Py-9v4aNz@v w:~2dX:P v50+R iQt-OEÅ|,ʂn{䋋s1PtX %Z`lPf&hl6 i!DBpN#W>Zj7|%ݓ(Æ!᠐>;?0~۩=^T R΍夐*!Vt3 kDr"Jd3UF[&%JFQ$/7{IwQ_3ɟCSWp&7\*y$ c;D#S;^:Ŭ}Tp8r >7uU7e(0 t #:$"c]}>!r3S0Iv7N&(醨@ {bDi8Ud߳dAjPnv MC4aQ`@vx(Їjc.)qנPlM !J#UC.ՊHH;zq@}c# P:pP Q|̍X{ۥr8w{x22.LYTE@ -0%+jf|< | t6uZ[YX]Z^0p7\I?ek2ƺzo`y9f; ݃T֔_>Œ%e.%,GB)Cˬ8\.HJj.kS x860 #3@Lfݨ3^z'Ws%>5'l:; |T#[:f;_'nmT:IsLuD Ɨ' ՙ 9dM+w>21D <1wky>>NUpZbֵ+T H  ۜCaq70!,&yv-JemٔKg$<J(w)G_ۥ^vP)Lಮs6 E]Cr'G6}Ms6FdK)Oi}  db̹jBT² eglhe"YB<^#]$P0Q ) ^_QT(w/dgQ6:2 qB;Ŏ) ?ҲoS,,\ \'Z1N\a;' Ofn7 B}W_ !gfuC-'eV?Gu[ 8Q2z#V(F5K-PdQT>]G)8u٪ e̡.8[ˊ0%hp v&=Diz} `c,?'ZS^4ld8@_T+놑IZ-3U.1>?zoJUSD#I'G DR0{%382dƅbU'|KR$3(戣Jet{ʎol9EMҹI.<]),M̨A6)J\8~ޠaQI˰<' G@$} e>*ރ+7*ө]qt&)cAeI$w3-'Z@x ΎZMKaG z1QdRф|FRHDiJ,]CSf_C dy;WB(ð+mf\U8%2 sT`eWӑK L4z:T!?vrWP M$+ ^+,`R9~5D{/3=NAU,+Xd6?<}tX%uJZNt31va%z]ӝ|uJ[Co-yөҷBYT/0 _rG'u.CzB0鹣9"A/‡]q)n.I7|o )-t"ժ q+ =*ŘNh蒵 !6Gf'y~ zU.l KLEH ѳo1p5LϢ>P4ef\O%rz-2w|ΏsG?WoNݳ shKXe-Uy 5ОNv|(\ƀ`P_BcwsةLum@O%:cUViJ{zp1lR*lԵّ٘o.9ShOke`O`Cfw̺=XK$'dv)׾ '9O S%meTq *?xWl%qo_1>LT!vR$t(~ϖ6eT$=RvZe\MJwt G?q,5 yZL'rM=R^;P~G-r`RgO,@ԴCEA~K*^us]pw-橚wrkTcրʐ!)+XJ~wEHv8&D'{p|\pxT./Q@IYwL%!#w毄,ׄʣeF(+dq r2zpu[ϳt3:r'yiK(,J#uj䕺$gn& TOϱᡕ5kx˩7:XM[EcWT!Bl|^iõ0&E@o5c@<{f.XڧuO4 b}ݻcU(4Â%T٥uSV_犸}0gt1`YT=.]v3LG Bn7J~Q} D |Q-xr0Cp4$)lZ7v/hwCk!V /{h]y:y+Erٴ_(3kי4-&HgaT]a,c<"yC8wZ2M 8EbTvMUJz^ՇL$\Ϋڭ"`LsGY{*߶*]SE;ߗQgv}mWϨTjUpH.OXѫY[J#d"%ـ!<3b}4!ÊK= C^5V)T&AԇٷU79=*vμ8)эUEp>LW+>*&6$M {LƫԲnE{/dyˤm*1aLsć]YOQ3 AЮbT(E8^U]d`W`!PH@rUyut>r_Y}HN*1XQe+Y; ؈"m[ƈSz{8t9GY]B4젡/3?H#қJ>B10}WywEIElPi}-I'=vM;9 A⦷@?]S s!@S$Uqf@-0#}Aeڪ踠.hjB6/?,z- BæX1!tK.j`0 7L}%^{|Ewhx)6'qK|J[H5ܣs,.pD/ -4P{(̓ ݪesJӴd,V gYFsO-)WaGst2Y_mH$hX(1t[)淪OE 4tAR8Di:|Ĕ=lMm ;V4)޶{@O=j} ŧ1!|U3e0?2X]9J]~7bsc 1:`Ow9&b '>Y[S_T]2Y$džWr?|e,B{Yx{"v={@"?QH,ucMɆ qڌ߅kY0]mp$ø.uZ&vAMU&8^i(Ĕ驛sɹ$U;G'QjpvJ} &0/3pzExQ}܂sFq X<y E4iDB}XM 0ZY~MecZa*IFvg`DJeIՁ^ FӽBg! Eն4NϮӋ{(qa6 Я8 AZ~Xž&,^y60=Mw5?))k,5w0 BD;0\r >x$_3ՑU93Au!pNM-w"v:Kj2miJT8] .Ck?-M$8wřB6fؽD L~V;i{]oגиcd[ZzRN>eRFɽX,=C(AUc)ÓrZ-z^^SA6x9βEgѫ*ݣE9/ g 1_5<:/PaT0/ ˯M噑f#: O|?k^iR`ك'~ ROQ5VI^B; ƝbqxH$UV{'@`0{FؕmQis\riPlgqčϵܦ jqYɽo~`P\`Fi-I67g-jmݼq<ΐ(4SzXp~8wp|rQl:PR FV'0*E. ٟQdž-3-9{%P4'~)S'$;9ۤ ܋c&wAsKU4^`3 %mK[ $2qNּ$cv$%w~a!>3d%1'4\ا5J]c~KrI}$K9,*<s K7}&V1,.̅RAcDr~i//,Q8τOoNycnxS="z}ʝ[;QJ`c&ïnʮbDb r{UDWgh ;@Nnd  rOEYOVT(N.@ d,^WI:TurT1supOcfkXvMo>az_x̹cͣMČ2'y 3f?IeMEجT)ʘzK6 =#9x[$ds;9xs2 X75$gzʯbR7H4mNOL./tǘ6o^ g|h[K8&r]K~럖 Vx.Nx׈/y4B_f639Xy$Nnʨz·.$)T͉&}e]a'V쳗Un.KٛI *էU-OJeX͑+K޳KVwhj25 ܰ%nvAH` \D/t"DmE1z h׊5h|iL[H;ju~[L$֋I('SI] d"ʢ.TVm)"py6 Ņqz+"=# [醘fMPAzsctjBPb0xt{o,"dW1dw(;y?, մa7Us #rٞ T43 EfGJf!5ym_װ v&(` hSD9qZS@hT\:.bAu] ^lYE.KQ9.|w4mq:BW\7 Jb艟<"? { 7U ZLWsmK9Ed]ZaK%3mqٝlZ>#:+3b//F OL^oBeMawΝ0_zE 4hH.H bfɍSZ4CVSӗSo+?NY6Zt.$A#܋nObHO] @X kUV3~)r a0gh ۧ&K$j4nFxḂa0ɣG[_iqS&DVQY R`^ET4O_'?7lp@R|6Ha[Kx/N0UDP~'L@;diy\D6JK*i ǻJMv[ACAG3t)0Oyb3፶;Ogvy`şlm&r3В6!Hk>y%獮 WZFGs$hB< (^k{fThԬ4Td/33i ĈCԝVs΅K7DS XcE?,MN`4)MUe ʲuQx>V.ӱ_+uS/Mr(p٘S3~rȇɶVUxKA² u4Ά`G.H.rVͰ_zFCҐCOŒ;@_- ya`prCj&9 :]ryTnf+>\, ,2$78P:*GL mt}UI 'fi`Q]}jq}skprW.3ho>AD,ؼ(> sQDg@wsڍ^,] Vq,b,+'}^2ty+vcFcg),>|̠O=B? K҈.GZ`jD WFsȏ2U*XqN˾Ā'D;['w*|QfǤā2=H橻?M55ǽ$vYvL ͤ ZY%9r:+t{Qh"Ǖ?tr蔒 WXon{ T/8i8i*H,s֧~0<*[ 6*,\%Џ5`%@ v8JqHS6ʫ,`.]{ 8|+07w&`ds%TZvx {C &$r v?{MAPhN@I4 + F?mB6aɛR#z?a8Zvz[3EC9mTl_u(;c qksB?Kۊ3] i]2"r}3V|PN{tA^=f@9Kռ3˛=U:{US1A(G .|wTBP` zxQ8$ Fqc1!"gA˦dNU;5A6-xv!>*T!p\DOe~nwUKTz;1o ~¶R s۹t̷p <HlAQ-7.=b:+^ &_PKaL6?!mޡ3<5hpD9PQ-?ˬM$y/mgm8nrաD?2)hg5[Nt.,eD*Tt/m; '1Y=Vl#l&} f=ĠX(i|$-AV?Z| lfPuR><<,!9lN6 |_ZNoq\:WZ݄Z2uLjf uqxqx8oGD卋反_??S,u"~v*Frfpɸ({S8=fʨi=i&QpTƢTI QcD _ARaa-v|WcUPP[2|'Igr砬g ՙMMǕ4ju![>B'EB -og,ƿ&ʗfބ.g!-;npo! bvLpfAИFua¨GLXlxs\M[Gi`ޑ`rA`VHMͯp2^l8c{Zv.x>nMD;|*ggMDfxDh&f\/d"v3g7^/|׮E*M* MoJWǎE!"]9G7evG5;QƥyJi rŰ1 e1X5) t%tU8n\[qr=s۵0W DI.A|ܟ۝C-^>BՈz#hNOẕ/{*[B8}Kx_%N:mCoc eA#a|R_:\:;zh9/ءavZOنftCO;DbA- ; Ga. eeKpv8/zׄ'jv'MKz7I6B5)JMH$v%?~Y F _@cR"Pt8(zN4b]\#3pQ<ׇd>|]F޼t|RIw>):DŽA=E)UݘQ_tW (TˮF#smн}NIG2Fs^"zhLx=H1p+v`QMN+<#QlR^JZcc?5b+dzr&r4!ސq̓=ŽvC-4 zwԧ02 v iŧ:yW 9E%*Џx$'8P@`2;A_f"Q#]ևuە[UOu&7myicloA$QO>JIs' pi $X*We5+j96n~̩,5nC:P(O&;`B 7R'9a[4l tK9u%ϙ+5M ֗._x0e8wIBEpH+ A[&֟q 8w!Pl^y K U NڸDIf64S H`iSN <1AoQ`k=L9!KN;ƧKGuAVjXӷc ~$KHrgT.dn6<_,8-`0MbXfAU.|wZ/ws(#CE;uhjgF啤Ʀ22 VsKәT2M i*&foW27dz)sX2OLxz#|cDپjl0לLy0o0oi=)XeU6NbtHrͧέM*YDD>6PCakXSjZϧ}$*j3?XƂqi?@"C&tb)Չ'QX0|ᴄ>1֝k2H&6|*ifpf%L9bo+]:Luu`+釖Jb0(/^ANpl(}st+"7F݌['@tCq.Ajsw}[}"`O.lYʬ ;&-:l_q2=`(T+,|I-ZR+HЇnWYM @EJ> aNhmHy^[4^*L *6d7t]X_ςB{^!mx?209T6S"Gtv,_"(SmѳJ:yХ\OO{gXZ[HFZ{0 K=;c ATSm0jvmA~MR_pf0V9aTV uLEFSgs5hLN팸/s*| a2yOc_@坪ˢK܈H-덛8X,w=VEXR+:px4Xws_K6%Z0i{e ^RWܸ _K3$ZW9~{ NvxU+5B1bQMW@6މmh/5K-C"b4t5{8#Cy_]X}20)Iu endstream endobj 48 0 obj << /Length1 1811 /Length2 11016 /Length3 0 /Length 12149 /Filter /FlateDecode >> stream xڍP-www!in w ]$8䑙3sUUWѽs>URjhJZ@̀r +'@ZU LK reF:9 `H;M]^l2./q0@ pqp'$1uYTJ0VvyisF ?I{ P5uڿt47hAA@* b fjqcd\@g0@'36dZ5O x1؁́` W Pw V388.WB ɦ{S'lr*l..,S@S;gK)%Mr/lrpqfs)˂-!@3d@N@cdfmw_MՁ] rt*bBftrpp 5ڞ?/ | @_% pqrz`2w@`wyrh/yY@vqzr**z2'%xrXx9~^Wa05?^?4R_j) (/g'Uo߁\p3MAv(e+T!/P= We;$Vv#Y[)Ky;q~k{7sۗp_[ʂ!`d"/.^^7˂Z=P6 qyIXB(?] `TF\v7]o$ixx^͓_+_ߐ7:_ //`9_ g/?Ëb!F|i/f._N_e6 K?_^@?KNN//;"?a h1 $qgݙKgd^vtGGLa\wL%p%B}ڀ֖σqN;dd)Įϣn-l+tmF!έ{G@Xj>ewsf9T.dO=0殮g&)}pxlp{}MDCd@H{=6M-Ddi,ms|>nkGM܈vRW1*zM!Ѿ2'Һ93z"YݎWEp>kN)L/FWO^c5Cn7AtYNVuߴ)Gz +Ν)ÿ́l1^gAvǝ-쉌ShEkRdPIs\[IcS3[5P vPܑopuʟ%+ba6]6dְ6cB /*{/?_r[iIa%ǫ 6> *1C ~/Ȳr!0J8J{=Dwpw"B&4Ѹri*{]G[7${‚úOax,/>/Ċw=l` ])|9FniB >rG.Z-wz| #5\l6-pD|٬_l9ZQI"#?5fE8ՍwXmmج2 >'%B˳ר`ߊ6q\ƈ |D=ZVLkWCt~F^+qc&KӜaT' kt:,~9ƴbf8|K;20TEg-ẇ RqgćJM=N$?Mm7 ] gR?+{T ~I8%O4C|`|;*6>x%rHZomK)7^21w""m?B'L2>GxϓB+<( ["j=?U mVnٕ's4dd y>Ys}:U#6f3"q-7NœSl\f~ejA?m[!0ElLV4VLXߐ;&oxC@?ΕFXoPJ.σ" wÐH& 0Na;cMif#m\7N T)&LڨM Ue}|Ko{d+H*Qr; $ <:7MG7OމϞg k%I9kwJtc]Ny s 2;0][;[Ms q,-{ґeP\;R״˱΢{m gJrqިM0+ nU /}Hq3Y &aNA #ܧ ؙȑ vQTkbxP `|v5]9 Ύ!a7R{AOq ˽Ӊuv~PPn=$9Y!fT-7DHh2[%dF}X2KkG`A٩tе-OU5 ccGhFSs{6Znk LXSP wWT,aQoF(!ڜIJ+B~US?$\0BU}LlS#aWE&;&eX9 yG!tU|V`ɰIX``48G2 }K[{9Lx-Z yjbre[ C;ԙ>$:۞LWBpec&)L.G̍q3Dst=bNt?Iu~g#t;O8!@G]_MlSTWXc|#y%W֏gEW-rA1Vf4891="2 pf ޟIk;aYVk^$׉ch{>|{V6.Tª3Z9Fi#{Z9rgog@= ;jnVuriky@`&/18nl?+Tb6ىHuʧKl^^FĐE/b !fwY:cl6xnfF9f IJ6)_]XJ #?Ru_mFo/ _sʕGrhd&wS"A#ke/ q9;Q1Zn-Ă#_ޡQX}Fy_pXgW$ GOP$^J%Mv8F?6,--.{˦'o>~UiZt9,"ذk2RIJ>wj$+N,8t!:[mQi&;*-A;tc8cNa\K^lOXÖV%zQ0_/^ՊHZ&{ӎ*R\E*gnTPvaeH>QDu5 Ct>dϬ ! ?"vQTӲ5*kMN L賲=P#N3qYLT\[ST 'z Ĩ>GpW̩4Q^XU6?ƙJb齽GioC8hhqFXAc ~ *uh{=+oCĩxqCϳR&A4`@W/Ro~|9y̰+qѽޏp {IW24gn ng kQ%h)X|7>XoE.c)~qP`|B?yyB9ŸqCTi,&^"M> 7kt@ @^t(J~F!VE:|1l_!ό}3I4F5j0߮@^s7v g+ ;YI-= ~+vq2(f\0J&:HsUCUr?MN!3Mvv# 67fA[D#ԩiPۧڕ#kCO5RkO&> L8h6.?p.e?BhA.gɶ~ⷛf؂k92sloS Ś2MBLc4jjT a 7٥Ldm7}PFizEI. J3G{+hNJj u{UcܔL(84fmܕr W+D1+y7 `th׍T@;dz9hE#TH; ! z 5gka=۴v7MLH ٶ\Yb;tAFu4E-"Rol$%{IiXToIJRb/(Q&2Tղk ˆ ꓽ]޼bV 8%LJ${ `b@M-Plwš/ȇTyOw&AyoV14s^#|NϷo(Z:><`ED$''P]i:!Y`TW*chLخ\Mφs; *P3gß|g^Jʤ6tn a[4#IQkxp|o>0-@+y@32]awzeZ2iOD˸oYdY}i' 21Dq5 x'K,5 7vy"y[i^e35pr'd{^&bAzR>gnTR!m48椽'A4dAK|#YTV8+/W9ג4TLFn6 9-7ѹ#i )2qn|oL/Lq3s*c/_k7~W)rNP**xhCe-c2tZd,#;+|mPff)k?VbLoaCͦBJVy6EN\' BPKSyV0Ect:E5kVĖs '0o4vyҳ!FӑV<lkW5h8 p 9g|5S@_HDͰW֘2ڔӸߪb!0u6n`$9M6Ӱe¿So9u۷?f#"Hu3l"$G0ӡ3mj*1'%c*+i[JDRV v5Eʑ!6VCf&lݽɲseZo69Tnh*P`"RC,_C$M_fݓO*wA^ㇼ4+`۝ڰ̢7>q}GMX\5b@wQ^xpVuf*_,%R2_WQ"H+ʑa"I(n [ R\qS10a\"Z`pU;"Cr̯ٓY-ǬU{'SkJٴ>wrpLvYrT%7;t~iLz_9|3z=ZjTD(J}JrL{FB0#@|amSBJU*lzjTC#[R(~,c #7 91.Vn+Y(aؖ2Xb9m$G%)R/o2MGlA<sG)Y?Aiァl#!eo9Lݙ198U'*gK "7הx僄11UoԤ$}}MRRcwde*A fliS[/3uuw4l+#,hdxg`e,Z;_C9x&߼)vJ3 Ur~T?W38?3mPGBﴝI:21V^CAk%,KRqa!&߱P[Y}c!W6߈ժe.9rՠp 3畔zxBX~-1q  V{d^|w+x1B L kEjx+fP0x2C|ʏrxx@GHIϵdU~_SPf6s+m;ғY 8eYA#/8}ξHVغfBAtdΟ 3.?3Q ӯ(ȠA P)%e]J ߊ?+W- -6}6a>`GQ$-챟M*mo5lځN"t||+{JJ\_.m 3 DO~ p_ѝCb y\jvw\T*d5x`?Cn' JjMaȕy3Ydܢc-_ ;f>.2l4df$|/YjƿXI;U:!Q7ZOrg> )Y+IUЃft>SzL,ZLVV32w,des|X*QXn Z]\l(SUsJlTS:3`>kf/4cSԩ]%%89/>H!Dh#]BXX(쌶$yK"ĭa8\7&:A޺`Wli?69:xI 8EQR^N}h*/Z:vNV1n.ZHM:lAuL'9 V A%;Xu{אX #",$IV&aH>Bb垩}Ψk:4Զ7-aDyk.Ӵ<ܗ kا1w!M{ 1'Ds&]r (DtG(&I?4%#& x~;X5[diVt+*k}| !}̰ZҀn å ,Ͳm@AgJ:on,#B>>r/3'w?4)zx !X}濾SVYSظ&&Kk'zPH9Q0D(+q8=|}rY&Ac@8qY bP!UIMR9U϶wryi fn7K^7A:I 2eyHQ oA`G3jp-oQg8ș0q4&NJBq YA+!ȉ\LH+ c]sZyk|+4 ]]!]T쥗E/w]L1u7 ȅE F*cc1A]*zvum\da//-!vᩎT[W7F7EГN. ,Ӛn]m : I9_V?_Bq)<]Xލ B~&CQϫLfڄv+Ao?ޛ0B+%ssu.xR_ssNx=zrj;4'WwCo|l|lP7R^BsoeV;S'?`>LUBk$f6M}9 wAiE~ò50MJ1:FzS0CHyڌJ2F-PORt# K= XH膶yhV%Ѫ/K`o5kBESJ=\UK._&1VykA9䂤g6=)ʎ-|a/tXusʏ$9PoXPCZ(,3G$rY ś3Qd.35r'hk~x5%v,A3P=5̅@6#$g;-3Ç}GרF6|gG|I#3 hͦ3dqD[ Pqzz]xU>4f?4q}1i3Iɺ[|5N4,P<Է&2;x}W ӝ¤m6!FJ"mj1I+/ G#Tx^7B*zO2xrZbOvuimTKg: >v['i28_ [5cPxټv9fFGEl0OB,Γp/VV`׈gM {S2uԧز81wsk eOf鮝mzL~wcݲkWL` j=:b( _$r:ZF%TRo*Oι>.syqt)T] fMࣽG+w!%d$r|vɷI !p)^R1[V*wCK&#ex8XJ%Í-ao%rksQl6\V͠$ 'i?%CmY'́Ck)= cE}|JC(FJRNDW8?D]IK~8QGvq(-.^6}#WQOf7JBah͸*_.lzj쩑?u_ul)~ϻ#J`3-}> ڐmėI`&hDYluZ̚yjY?xjNr*Vij-M_]$:]/*m-ؤ5= buG6*l@h^L4߳ӥg_< (cJcۖB}f]( _d) >-C޹m7X"p}P,KBc(2ne Uj3XNTI9:J[]QPK!o;|VWĔ*<~^!n`~Y%/>G( o~rOwKH:*؁Ȥu2aZpvld_lPVM7< #+>9(63d⨑{WsI델gܴC :)y UڶsPX(bb^C2,BQY, s8,|=E2g7,ſ•'=`{K9RԌVW7SzŰS-u}S;a5?1]L 8][EULܲr-=Cwr3&+xa;(GyQTy\bs &MOH< K+X{MR̉S5߶]aC^v{u\4^Oo,x}m82l0e*dw}*aa2I ݺfݷ7y=\]6kXbWIA yW"jݬ9m! $w¡W^)eu endstream endobj 50 0 obj << /Length1 1537 /Length2 7715 /Length3 0 /Length 8730 /Filter /FlateDecode >> stream xڍwTY5-nŊk!@ Rܵ⮅Zݥ-V)vf{WJ9< 65 "spqҪZ\bbҁ;B4c1A\ݠp?]!6K8U8 ppA 7$W U cr04jk~_f0 KHHw:@ [vm8 qW f;wwga ӓɍj+ nW5afXL;vm+pop!0  _PwV#8S_ɖ`0 l ;;f+ ~oa usK&Pgw7N7/_eOYf- wrݰ~O 7u=a>( k3PuA@e 7am@ x퀿x;C~;~8Ý6$ ~PoV[( f]^cн_<s;5 ` xBWjXB08@ g ?Ugǰ^7_\gNWM!9o7ot:zpd}W{ߡ?:Yb E8W;$a9F bu!nᾼ#рA_~;ܷӿֿ`j7A!^ r){z~+֯u~#>A w_{%!<?}:>oQtu@o/` :5;? }Q-ؓcsHtiS?gֵ qRz&`a]Tbg]=FDKfyf+ipd]7C*-[_ wr]x]^uݥS[U7c/tcM&&91Y'NƉrhذv_1Z~y9|\ۭˆh`Էd%i1͜JYQX3Jtf|쇔;0dvVxA1˽nj3mqҤ'~&? 0:{1S-J'Z>,~5YX(;K{Ámlw')CBCeq$\y4[)b1G[)^Ӹi8uWCq7%qЕq6Q5s/0rڑVx,.}Դi ?7 5Ef>7)/vWskRgNROz;ݑĐ]+7_Y ]%{vuӅTDdOI~O u r'+ J(k9/ ?VH.LGDXw!G㘈-#[Gxf'| d -VޯsxsE75P|So&k~O~&H_&\' n.T~xAg2Gʆ ?Q~6dHԠJ r*|z'%~{@,Us=&EE`׺NqM|9٬LRZd kAǘӇjWG1@/:ڴB s/z15s;Q}GH&γbo\h&%?(!:F] j;E韀jh_?+t1IQSI6vy_Y5sA A/gǯ89DV(0)[eff'ԟ}6Y]!칙h9-D]]]; pޔy *&_0 - ob:w^M嶂I=q4%^DOSLH#7k>AV#<Лea#+NۏL# 1QG9hǡ*ĩCnE)XHFwl+Ґtsl1_*Ђjf*Q ZcFi8,⌡ӹl_2Cq_B[Uu$1m$8`zMб"G}@=%ڸ/ ׍xF@rۛs ^$%z WJPp,*M~s$zQ"0k+w%\qBSpgZcp@ǖ3Co7$sfU7c1PRp^8g J?cl+F/uGen{C?Svn3||RlE?7Jǝ3eQ]|.f;`{אʌxD1pl>3~FBV_j~3Gsb~69a;Il6`.+c@0(5IEr^XBbSCT1 ]<"6ĎN1296a\9*؇}%r j۽ũQ'=p/:D6BmYIiC5}ŴGB[:TK5ѢA Z[^V96597,MXdV숢*6KWЅTƷX?7۵"݄|3.dD\Vb^[+]QŌTja%!U"k|GJI]g\DSx|]ěǍ [)[ȓ _J&z>}v\t YOγKw<Ĵ8w+x̤B,uPJUE5JTe(`_c`G`/@etޓvcle(\Ǻ@tMqO+F>Y1klgOO)ck?bHbZX?}_frZ9]CI蠽Ù\(jf/??j&kԼ3N\É} AqNo=ka#oƝ+GIgT yoƈh36= 6-*c=wesHoN}f(uf62iCsYo,vuK^km4,U+bP9rA΋'\`p 2)Q=kd_aW2.k;7ĥJVCf: 8mF KEmOUHMgQYc_R{])|dG$f)ld1R,(T析whȝgp?=X:& 13yTT{y5lg}"Tz&t~f֑&|R"^$蓶#]In+%Д>Ucv3ኙj0/KQ@ɠE(Z)?W*Х-ۡo5x?ʅNw`v!ҢvU|=mw,djt\2:Jtg-+x2&\)譁1xu輁m҃(H`؇NLJ8N,E*f|"Sݓ-AX}o?XBRY,U׬~ W1cX-ZA6Oik P_ 2Ρ]LL0]GԼP4S`iV*M*- S~ujLO$9=Nf6O>~.C,>4 31p-":=7Ꮓ]gi?Ȼ@*L=U#|o( ;?ʇ2>?T'7$BK.\ets ~LC& ڲcɺ~U]d[Nf&{%٢Fv ՝t{ꃅ3bIfOVӈD0 s!%oԦ;Uc4<_13~LP=*g49ܭQI 7]tl"Ԏrqh?56}{`ZV\ 9ߙ%gB'gMzf|lAsnR99;Հ!.„9وӏqtYrOCCw>Z8>?, cɺ6A _Dl]x;=z\:q䪍RsoQԬFgХ*Hq+"5ыKj6nZ]rL)iO€C$|~2 vz$~3fi)^qr5TB VLKs;mZVccM5^lcS69SfRI ߾Հ} Fvix>Nzh`HZ>RsV: 8~6:zBg28y-S:9$ZULih<.دp<h@ɸC*uXyYޥ~!CS|eӯr'YǠY|iP* Aŀ5S@d,݋ ƋbFW5GB~ip);Dfy("c\!O KzNBD{/^>+LPX6Q'G(Bs/KYY(`mьrz>~!N3&JB#uDٗd&U ŧ8y4+%i{ƛT;8Yfq9^כK8}淭ȣ|23Teba*Hx|'sNƵ\AQxHwAE4DvfPw}@ P[DTnXѺ싅Q=k{+)1aS]|3OWfqװ03!A zh>P&UtMd`Gy\i8&D^0ΫGY6d zMLфW"&h#pM2,vi {T`idXn1!&н(r~mT"QCJ;{9=X;sM+KA1;"{vϘ&USHLvI4 = poYdJ+CQȨqGO' gb4Yl!}&n.Sv8vn]\|2v& 3gV>H02,Z֜e3m'ptdEjgJ#MӘOőg]u[gXFͨD+9ϰ$6pT!AbN(ϰi d7^#aQw%ZHCX0sɷFOEbHQaFm{~(Q) }K֥I%zy ŇRqiKb`G֑~[5y?'"JmO6k; (&c;<34I؛," zcdL A[B)ejMĕU#` ] ؐEQ|>[Bg=oK' BNpB$xE'u>J| ~⇍@3߬d[}1t~v,\leI?g:I4Jyr߹_*KQ Y#  m<`A]߹5F$m<ٲb endstream endobj 52 0 obj << /Length1 1717 /Length2 9887 /Length3 0 /Length 10988 /Filter /FlateDecode >> stream xڍT. ) ];-^$@@pVhEZZ/ә33Z|{Ih)4Y%! Y3+C bD;ۂꀠN`RPLLbPp@^A C? @lPf(@ANR(9 fow 63(8[34!f``rvvdgwssc3sb@-EYn`g+ u P1&ƆJ в;)քX8@Ag- dbos4 ?4`u4 pyl b`bXmAUY%6gwg&NgWMg~s2؜0d#!؛KA@N' ̞O݃w[m!n^>[-`mvtKe,BGf rppp  G̊Z} g p|o fS%bşP;@y?^?>ϖ9eW+7Uw+/=?wo 8(ooIC`k]A< ?coa.3Go=. ?Z;_)vq~e^ПK 2Vy3$-m>D,dv6sӃ`{ 5`rpylNVWS؛A9N^ jg>/9\!.gz> ~ؕFv/]o$lix$pa7As- .<vs6 9?x >韓AΐR?gw|&JϬ  Wɝ rxOAW\*=?] Pg fBﭫ7_WHnLnIadb"%1gB/%c/m0\/Pθ5, \]0%PD|k)R ~|zz"8ƮJw8ZZt)w/[ !PLkpEdNf'U\D I,N̯W#6`3!:*tV%IlY/Z3=| |HSVxt]׵$h+CTε5LVNu%DA ﻱ+C8\ (VCy@ )_ïr}?z0tйV['4!]UvQm8W"2VۨwL%,y~SMf4=*'mA) P؈7j mfT.k F~a ]$4ci)XAUXtxm^+? 'vͷiW/闅ѣ8v )g~Nqf.|}dr`:HOMt݃ƔQ=g)v*{۹,UhR%>WXULҍ^|KMd$ +WcwQu=\l(K6#Wrפa.\3ZlNx*Ćy(KShxRT.J{.sZyA7S>YרAdeC7q=I(K]ՋMz^Ѥ"!$Z@e^c_t&UrY.VlG,,3[V;rR%'g&=ƪЕEQeY f:P_aa"lv'0UԿ1 P8Ύ]G%6ۓۆ0GSWNsY(2Vҗ}mDYG>>_>A5{f (g}|M;΂e"^=NȜTKm3 *M'T,ʚëXFwh/ag.lu/=6_l# H"Vf9e;-kMII'ߛPXf#5J#!~d@P 4"GKOB~qZ 1yLs9WA4hr2ؼE[`}h1.2+R``'ވܬܺ{.:pڂr٫ BQ0 S\t˹KyYݟYURD}.GD-+] ,/3\nLd3Զ>gJ2`BC2 @V۬XlVEBVRXn[Sp;QZ=PF%"F^#NjcMbԩ>iŇÏN360~W6 M_5UGu ^m{z?W#D'~{DfCSW CH]1\4Ħ 돢R@&UyOM/̒8^9˃)'suݎ/jj=A[A| &mP'1Ƙ`eʒ! G!6x Z2bV-yPkDYQmNm 5|IgJ%K к,"Lsfqt%sKZ'&I*a[Ec%tbG]^OCanʅbF,Bosm4)>cIMx6TV`ula\o#]>Ln G;ބOrFΟMUQ w^&e:{M,:!Yt(&1׽djL2ܴƓxlf` lJfxKCvl~1ʹїN|FY((*Zn4vrѦ\س!^awcɒi)(?㮋sh+s})[8٘Y,RD՛ /4 5C,?artI8~6Y)<2E1vɷeKvZ^V@.r gW䂟mrӹ ħjOS9%YBWˏwi1uJ!28A#˛nioUBtFڵtv2]lx)zkE&(Ύ"7?En]~pZX=}q7;Z`?ͷ鷻o+t&~{j$ľl~hEp6E/G?7uoE5סNj5ͷr_U4udҧFQjDt@o@*+΅io3`Lף/v>M%-RxKѫ>*9=lqF@s {!m.OWU?!vJ㠃ZY W+R 08gE.ɧ e loֻ@!ǣsQݢǹ*xALCE5kz>4. 8_ ü/ZzoN/Rۑ!->1NA_^鏊eoiGp ((l h'yL_ l˽Z_O_ g] ڊ%@z[&3?ӰxS&E#Y]E-W="4ſ\_ ?ŧZm)H'$LZLj$.6!y=[='Rip<5WmPʦɱpS4j9ݵA;8.\Ԫi(~J- (-‡:OQ;30r7pkwQJ3eik zrpoo.>+Y_ 3A2G+ܿ \)ym 5 {6,QwLDq+|h3N !Ua=U<<[ Y\31edlj%9O.j\"rrn33hqxcÙyA-**Ndr{UJu$D4eG|$5m@I4 oҸ_\սmtc~F1mbY "I(?^e[գG_YRߚZz,چVe Lq # ~\q+wUzqlKE.8Nl0 R7b/#hc񺂌iq̟p2;ŠO af/Z+K%GUJ 瓂i UݯMqmx <?!lEL![~˯ae֝}H }T$!L]PmfLErAԠLf υ7Fh.pS5|+aՓ oȖ @g@'^^v䴯$HgU %qe{4n--~;%#淖Y2tX2f#BLG:HBWr ݴka]ӆk wnzaK$l6D3]y%Hs+RZ|vǖi&C!22f:G ߅\!A`tZ*ëka߽7X9y=%gaRD'ϭzjer0g KbwJ Ω\3; &&+\ȫE,n~ؿ?0fۻEЃ'T}+Ӗ[> upn:˷{DFI6_mV|Go bRBɡnr1.zxi9̲/stVDn̯ ؃*vԄQN)=U*D264颚KmZ#`l0P#13Uc(r/O (i'7 ؟T5Rx$nZy]uP%r)B`w"* p6Q'z#X_ n%sZo$Y~4Kf=m}n e&}E.r&fzHo#/cVk@fN!i-e4vzHJWZ1DzBɑY^*.@ĝ6 @svbqAy_o()^_̱G-xG]x-uJO즬°͗IGF^~]uѧr^;ת_OJ?*y~1nƽ"NܱB ,R7B[zU1=.bMM ;)b8X["]ܧ<={9 ɻ*522f/]n\O˾+`KX3d|/@$@_n6(Y6ȯ&VrRr*mQ[*Wیh].?y)ډ  \{mI!+;0w)|ٸ4>ԱМI(r[]b>h }՛m߳XslnԧTF-w.vbo9*Єa JiHc[2ǝ*+70M^(o3qjs >wJ6Vs endstream endobj 54 0 obj << /Length1 1427 /Length2 6229 /Length3 0 /Length 7205 /Filter /FlateDecode >> stream xڍx4־ Z( {'zoA c3:kD{ Q# JH{}Ykw~9gf =D@@)E@a"cNa @@({@hMu}O8$Iĥ@0(7!P{:HEġt9:1u~pCx IIqEW Fth'+" !!0()eh7)!!oooA+J(P jE v&H0vr!`(c P ≰z0F=7(/_~AJ'W"w0A0#Դ>h~a xa) 074J(+ UHWW("?9w_?uA `{_4=݄L0wO Do# JPw$! pЀ" @{xBA;# A350#?'k[,jJJH$@@R @bqqQ@?f۪dD8 D(YA3o?!7y~+*ޑ']ap?=јAb&P3_yW ̈"s=Aཿ0jCCԀP}$ DÌs0-b&uU=%D јc A"!0 r$ Üf~Ql; B#!/;k>[^IEs>wVrWzh_M;?W9>w|AOnRF>Ku`M@`Q#I8.FdD ׊+ex拍.Ԧ6PrJΚ΀~׵؂}=bZ8b@^vˠMD;!a.K\aMۉ_,B/+4 ,{ ɏ|shKxLjTК7L񌙯&v:6}4/Nq(Fԥ‹M mʋ1&V`7M߉AVgCl4pWR&㚋Y %6 R!9Mh ~rrh"Zk})ܶbKQvpǸHV(trS&K_'!s=׾Gۛf *:xK"[( -fh_ ުn-GjLQ oquwx#IO/tY USKvZpeYԮiiS`:^0}+䋂([Jz fa|㴹:ۻ,gpyFR4^MaՆuk:;XiVT<歸/lҞREOIgu9}rɳ\@g28NZבn~:YLzUO0Sd}ƂW[N|o}*tjnG9ʮlߛҲL2TN+5Pq"#V%tMyo]Q=MYb9 9 ;c4bY5VEA֢`Whǫ'aܪs6^vFXdm%}Gf؜LJuWRx߇{ޑ]RtEmDb?K8E} JZxHSEɆ~)GMP8}%|仴Zk;b5Y"A/FqC+򞋞ݟ MeHKw6\eX}`9h2j3КBތj J\]f5 &9^ڛ_ 4b+NvieC(z%$KPX2^#J`<+{+=98?1FzsC /5L -w@}zj]- ]\ea}l(\m}E~{]Ot"K֋-3^2`jvFؓp!v#]\o{pkY҅ؗ"Q#M^exv L ʝ:0 ẔSWg .{~K+dP Fsu;xջs_>w36bp|fxu4򒾿PTbQ8j*6G[]㣦<|<oD:o (o]1pMʆ̩q),"\t-^|Q ORЇlafFxxyގ7F~S~suuxSʀ^,%36B߽Iܞ>eFE\j@#zmY7 $K ج^o5^Vr`0[ȷݕUqo4\PMۗVO'ioJ2<5F=+@]XzK#š*+ts-멭=hxWݘUqjL)B?ZPP҅!\#NPc{2ѷdPg*};hSbp X8IH_F {GWm7$n6V^ G?jKȌYd͐|\t1:q.h${{g}qf\E{G$I_<8䒙\ƃ 쀄ICxUEfG}+BƧ[+WȱQ#sd}lÚN@GC-o'n JPOz눵Mc(*JZzǓ;A>g [めcޤ68ޥ6+R[*K[z hg Ц7^Dl?HKB.kFs9s׮io# cpRk)Se/O%޹ܙI){IN*.,F6GÅ_(jZG9' j2*ܸHG4҇>J,㵉gJ⺄(`^r6, eu1O޾ޚKV7Ksnl|qas9"/vw8nM[Y-<˽Vy)ksz착TW5x_uy =QOs TBgsD <"[33X:}Y_ퟯdp뤫Q9_QГwGC"PL]uUmn<Trh t'z鋏Fi^'ʏ %6>jLF+'eC. [V[ | 8(4]-竢(n~u$[o ~|wH q~襺 ^?8΀ڄXGisy[$5x:^K֖$ vsǬ ߘF%G => 43ԕqA+tTM9GJ: NS{n9hBiDe=fh(/Ed qU.)ǠVCO=U"sSbH8%$ޗo{)AT䉇EK9rcBMM)^t\"dYXժS\مKqay'y W=\2^җ H{,yq]oh.4{jI>Uu<,8 8֧BQtS{=ijH?t<ŚگT\MI;O&zX͖㘢4nl`^/XZ Avmz9 ϔA|Q5(b<5-owJoZMF`/M: YN O\{6"[[z0B*\OtY=ܻv"F˪$31fyOI` Ȭ`:jwFyt;d-P퇷GJݒ3[4(k])y>u¯8bIe£LoO]%Lj-K979IȽ h~K6@C.=~(;M=Är%^ogF זꥱ=[Js;H9x'.151*Zzt=Q9܎ %YV[A@j߿2ې)xUxM06 "&lܲt1 _{s*w5w8${a/>{KUyvFϿ5չ2T$5Eo2/<"7 }Fm`,Ld2ߏ6AHˑ3$҂r8eΖT ڬ[e4\7Y+$``5EnZ\\q;`MM_9}^1SWAFխIoӸw6)zS  /X_pѨs܋e~9+RKSvˏ'8ZsBtX|ou֐#݃W_⧖Z̍شG<[t9^"̬h?xLcj3+fBjZ;'AStHY? '֝85d$znMxx4ŖJ|c`^؃L> ܛayN5Okzc'F=!Jbӌg +̃!\,4"PmĞS ߴGmݿolnjC|)uo/ԁc_wڍZ62?bOj[85%Dhj[ 4&ɚ{q32Aj ^z}VܓmA}IrTX8_ϼ:֘G*G%esLY=e.P6;+L,&p ,\5o,sQ^싺[>1R-i B|6+V˻>99"^ endstream endobj 56 0 obj << /Length1 1399 /Length2 6085 /Length3 0 /Length 7047 /Filter /FlateDecode >> stream xڍvTSk.ҫ4!${oR ! $"("(](MAQ{׺w333{m^.#SQe(BbE@<@UJIA q ^^38 QHPE XM QH,K˃eA 8$7AP>B0(wŗ (Ɉ(#`h# Ї`]`|EGaqJ!źˋy{{! v)(c]&0 ~@?̀38a CbH( j a?`?_gIWDp`# AHg 0b}" qà/ 9l E㈆c1@ E_i𧬎?58?v؟κ"QHNp$ 9 V 7QcsaR 9iiIqt 2Nx @`,^Q( p9ÑdǛaN>^{`xyAQH7?474?>OT *')@FV,7V#ItBP4R_#w^0?ʷI7d+K! O7n ApJB C-a&Y{"۫CW(Xcc4>0GG_ 0_|_>9?*|~`w]u# kĥ45&.% -oCx'W[%b 3/'ſ 8z|׿G9RLOB׆(y. /E&XuGHa>fjyC+M= gvCg ܬň09"D8FVP~@q) t}~Rb boHL`l%|~kд:ibKQ7l*}-jyàJ䌰E疗PQ*(W|r5a\RI*ZBZa+Y.^*h%9Y-;>G_MVmrQ6Y( %u EQӴ9aOT(%,wF{If"02kGY8H1̣,#mFP6yO=. z{ZDGYp;?->'@qa8bWb~rm c+7zR\[Z9upx}mS~&+n9K)HzZ=d"ݣ0O #fzUv؍e u jƞʾ丮VHhTM ,=H$d3~2pǧ: #ۗb(DjHnwh2~һHZV[9u}X=K5L0Pi !X~Pdܦe/J*<'`Y=͓I^f5X?*Ke88\>1RբMp;fac}\׺sƾ} }sL!Bqz} *u+uUsٳ$`wRnN:I R?Mbw^{) zNNSJPyd UӚk)#!|ږ-z])ᘔ\ϼl1H:٥rdEf5m&/ .S .i&y5)s~Aj#7\~c;;-qÞnlmk`b[q%Nk_z㜳71 M,[>iP 3@jR7uv<z/{N6gy4c1,UqR!R+ \ZP0DU%fdLLCsy ls?Aw}Q­G Ac}6畅UU?Ofx2mVӸ[AHmK$IJ>_wYyW!>a2R't,yWÒu_uW73yS  we[s`4njU)#̝O駖}7$X!2}a,dR%i fRpʼZSD/5-EԄ~d 9{۰^kvǭ0>46 gn] tN'۬א̕zr>%%e$v჌"qQg}/'iDmp=Li7roG0jL#\]Sy$_ uˤ~:QS *N5 Dd𔐸ȴ.9rAlH(=0H>ߜ0f#P7tmV5xnokb4,(kk}~(]{^r8¾0^7o|Yj/CeG{묫䓄c][r{ZrX,ݲ+hNgޱeX _H, Sn4F-T̬eC^ [fa;s+?SA H R2lD;W.- tU \{cnB셮c>"[\9a?KQg޻̻Ǐ>!&b~MDM11-V4K :;&`: 2UErhf 1yJ]m U( _rHJzWyeF2%ME,Z_~ZTp?F*s2U듢os|bV飭* \ݥbzPza ގX7e$UIPfY2Ao>̷"yZP^0~^lǪ_`ig.ֶciF:aiF%B#\`>^exYgCZ-|d$A{gdwέ4yąz_ǩef.4> Q\O+ ]3aJJ-/;;껛A.}d}>j҈\ [~'2tH%n^ޙ}6M>}'bҵUBtfU>alo|0eɝ$bN./~rKKXN/sAͿm˲hk׫|ˇHnϳO;im]+aԮjLK`/Mp#-)2GהdH*8[L:go]TgU@^[X@ʩ 'Z[ƇXMԯ;ղ;fiL¾}˼?fv& Hۧ>MAӪtwV|ߦuX}4<6ݡiW'Ρ}'2٪ɯMrrW^_qGC;9! ?LGV+/=„I2 P wȇIv[YW~j.J .)O &!zÕEk#j}aicXssѩs*׶}O4x_;*#mӉ:S8sSC*v$voy.e3w (_C̷gy3W.,c{Y!I'|lђ1'@o54 `zOF61ߖ%:!#&Xi`V 1JY4ǩP3˥yģ9kHn7$g5N;9U,\ltd+lQ6E&BZ<^yfT%rxDǛ]yֽhlyH@S_9"9,eQ$|DrAoڂ9 G;7rղ8.0; x 8mrhI[fer"NRVʛa)aӫC7 eT!v7?tmZp 2$|xSGtt]5,iTEl/MŽw5 9؉x.i_KW77£,j~`\EoL 1M _ ^)Z:7ԎJmҽ$ 픟ZJ9e$ ,qִJI(t P2C%H /M\ez'$,zJ$7L7nPsG`AQ}#C r?v9GYb:VQU޳u.D ޷+Z^Ϸ:Oքئ63*_S&[hvh%oakџQ- m*ؘs9^[7bmSʳߝwd+؀)cMIIOzʱ&5lz5uH}mi1_+τަoϤf{҂ޑzcn>:lB㠵Kknk #>J>|~#@ x93l0N RR8YɌra)MBIrFvmvɼ"o͔4s?pZ1=:_ʢ'10iqo9|sllLxT*գs&P8ԡV endstream endobj 58 0 obj << /Length1 2570 /Length2 18301 /Length3 0 /Length 19784 /Filter /FlateDecode >> stream xڌP cݝwIpgpw'AKpg'{a֧{uJR%U;#3 #3/@L^M OIfl Ζ 1G3Hd(og qX8yYx<5s|0t03dlNbvfΠ< 6p:Z ́6ƆU;c 7wvebrssc4qbs4Y8TN@GW ௒ 6Jc[8Gjgf@[' P(mc,z?0Ylhllgcohaak0%ݝ&Z;ف ] - @S7H( AS_52fq[1;_>X8A}`pllL-lML*Ş飭 P?6 o :L%PdK ` *ca r2t]>^*L,F@3 [Ab0-̠c07]ЄZ{6TED%)_;`pp|7ʿJp#?%z2\ @ P~ffcu/# k1XX{cfgfہ@ v6mpp(Y8=1=Ptk [_ @+glS@ ڨ(nklgrp  =Ab 019\|v)'I/'I70FI_ `XL+I7b0IF첿(o.+F"nPv]7eW@U#vo7qF"74t20p4vW4VNVAEF FV@#__4HdKbc_d/dibgmmwPrwpmoPm]@tM-\ ? o֠s07aYA,';P~ dj Z?~9To5(=j?4v&u7 9,A~:GX@p]_G8@NʿAU:Y:D75l@9{@9~p2s(@P~CVPP? (ZߜA6݂Zi])Mx]`QBër~}]L *FAz=` v*f#08NA%ˌ{y#ZiܲOnnuIEF $ZX_"r Keޓ ,T O6Kʇu=U? 4G@helHU'PdZת+8( M&-{-~0{wknoe]I-<8tU%%dEF7|4_uZ)gJlyMawwrߴN!?hOeGm#!lVyi_o4d]"[݋;sou9Y9"x踋QgoÛSl?0O{|wHL[+8^ /6=eDYK_$d}C ոDV#bV㢤,B4~dT'gcYjj܈ϻ|o_n)̋P`?r+F3K}ep>ArlNIbmvJYU)d~%Q+"?I_A@)18#7,0&y_q)CƇ{ԮoZ ,:)-R0h'Æ՘&?LHkdIrjXFaZ-"uUIAbvڑT]lK;粡$ !MxƗ_TMwGa~m[sƘqn,#lF9Һ?ycFvLJV"w.MN(-.IJbg^UTT.' jX:|$*EgO1>wi@#/Q%U +zMJwnf<ݏqf(و ~\aMk Σx;RB1(*kM:~c~#joT{`x #jy!ɳؚP(AVYQ2\.57K & j+m<!RnM#Q eo()xEI sl1\akDS/I`3:u$ȹz4,-vYTh?͠z+]>ٔV*HSOTXŇHA^uR]?ZhU]wv@*>lZLq,PboX }:fW,f.ؠ8ݫxi܌dK<;ϒC(S`!VJjw)|P%ˀ3:S;8BQ9++:/SX3gzpC-S_g(nÉ]WO>vÔQ5@`T@2_W Si$Mm -Czu}8#sh NK?ɻXS`pjÆW{.Pܾ V2 fGYNZh5b4#*!2tm{.wCcQ c ŗ!!g=Bj!qye#*o(G4n(Byqyk%LELjdT9hOI3'=4 ^!*`N1ʔDLL Ƞw'#qB!^ pb5D5|HVw  ʲNIοbkŹB_"K:|`Ȼz%pCT'^;\L:4<̘^òF`א4(_.z`e# xkAr4$}ـPFVbh<ʲx_"m&1kz;4f. &Zc.*39qe]YPj;P3=8 Z7I}pi szR'l.½ָoqc>!4z,^R lꑪɻk0]M`ywgh*ҕjVfFR&Լ[eQׂ~zK^z ƺ[v !u7ykRj+b/dE ] L avrH^T^ڛϔ菥&Nb ߞ9$}G~fGD3&eۺFNT"_q_ 8\dծ+°57mbL{=`@iv~Qz>Ir&^=?0BɈ5dF@R򰑭3,9Kg60DA5rKDUy5Bͻ6EV=Zu SH_02.3kO:X:_MeX0k0z3(w"57LL8ֶV!YFshVɎ ^ pJ9m>ݬ`1]m5EX}"\u3Kzɋ;CbNH~jW^ogӃ`0quG2%k!yDYU*٦'k<6+6R2 [g}_4I-=]AgJ)4}!q` S(XV{4hΚ/pn2OSz37,B5 i t YM+Mk&CR5|m^q |Q<gT3BmMGg_{ ]KrHK]P=QwtTb"[]!hBJnPx/tDPzda^JN6%+1-<4q%λ>hUĈ9bN*3E[*nҊJR|*>`l@vH/C>>at-Yޘڔp 2AeV⬹] MĻZ"q_~A@nT81=}8T:252/b C`LSsK?1}qo0y7UL S9 GSFV;7mN$\EiFʂN] |7 i yL1,A/z$V͋VY ar@ti7W!ZsR=EmFI л-x&mIU5GM@*t JoNeD366|UrG=R]6oaڿ]~܇Rj|SMe0pW|ʉw,8l'eT3CM^ჭf6S6a1cSGE8CB4 +~qm"rX2 Bcͺ6 2k\eۉClΝ'!ke|7H6m$]=̘yՒTʥUEfg\uy$p*Vw'`vRa5_\=/3z?_/c G%FwiMBe /h7G}#wĮ+n 2T* <gfIX(s%ɣI3b&Ig" L0k^oL,NW\"nk"3H !5}XHLފCˮns8in/dBh}jnyڶՠ.87FdZ΂a=7CVV Ga8j&mo>u0]CGY -b``ط'2Uf.1I i{3ړeR d3l'?$p5#bK蜍Wis B(z,AW}k1f6UbBX5J E>N5 >b,tyfa;6߸&bA ݏ>`y ӆ }Qwq^WpbY߂SV @D-u]U e)[Q)+BB/X"+@@La4psD{=["?BO#tFGηeq,G>sӝƓU^;e'w+?ױG6Ǻڇjb*7.$$]zjKC0u1#S׌Ƃ!R0!Q'[$MO{'(u}/ Be857PNq(85[/mZtl5M 97if\ȓRu}RN}Dyi[+ֿ! dWh|=cXG˛) US"$8/DxBڸH%'ݑ>E5;imU:p:dJ!wk-BWDT F%~ ƾ)uVd9:Xmӹd8BJ8,\{2&6Dw:2'<;O_'!-P7cZ*ޅ8bb-' RD|Z ?inW/~V].nYp޺>;,L<~ 00 ՗3MNi~/cF]5|hS㰝as N~J83B^=ұ#mj#*Qq ANNP` b 6CBXHNcuB\ e鋭#dwua]Y?Eq2+>E`ato꨸͹vERK6:]j1a'tQm/^U!83Gߔ}GEKVbW V|ᭁ75$_!?YuPCa-Vuˉ`+9?t"Dy}53Re;ضTvb[tJ3rIp)4u٥ECp9hܲDSڧ<+:ybBW!ٹv)eLe^Ƌ /i\ 2@ f'EU?鰘^EL 6 [$Cˎ-J#ӹ23'p9ӓ1ga7^"XpA3Y14Nսy4.#fMMgJO /ߣ#5NbIiawuIKAR]fJ }.VNCҏ8`Rf\u/8cwpEY/1(hD oF~Dv[X? 'c' xhzMU[4? Ǐ@A/.ԳOM1Dz~Kn[anX|OaGJ7ՊF5ugy[_+ҷ ܰltaB85XI{v_m5bʱ [dfЋD!a&RVìGDs:!1 GM\^#؟Y<_A6䣤(=+#^iulr` }^rdiJ&Rއh?=9ӈIߞq d@úT|g<;9ܓZUϒIxxWFdZD!م.])Yp`̮UKDS|)@0À`rܻUe,4Ao,GYDWN&>|B_Ea97~'\+YV7$r@y@i/{eoX6!<ۻOQQ^guYSx0&a 4г.IjŸ35?&.L$4bJ+bߚ;gA/G &'\[=l/sS91Sc8&EUVN..gW!E_YGx 9O1Tv$hZryT{BR ڑ8~O#9-kދh=hō K}ػ; ۋIɕW&ƵL!vމvX<7bwhj^9/U^(\~-@e@J<䰼C.C5+:u<9OXlkBi 7Q p-Ώ̟ f^#;hy:ΟߨwR.\Ox26-E εd#渷*a1ӧo/ pD E;-{}3~/}^Tdl~v. uNo?? 2Zvl*3^@ggxڨRE NH4oPE4*lTz8Uv2eF4{SR|ˇ'S_NsƀSHܟ +[w~Kqba_8&YNV1TEj2+rL6'\;yQCE9Xqo-GB5V!͕vtVqf ,zѾƗoPdŘ$Og_1IZrnܿ*,a~N.|Hxz1(I&k0.Vx;t>G.BV6W4 `-&Xʢ'=yH]]M/`Ԭ>Xu|{t fS-qf -rv  RFw隚-U;&aVBjI$cEup5o!]c ~Aw;˞bx.rø .\RҒ:㶃C\f"p|Jy. jMe:rP O.ʙ*ȆK_L#e_g,XvYM|pw1.?Z"ZLo08&rݤ3fOKF_XxYXsv{@jR?A4=גu{Y_6Q2D,0ow^UӰ9"Dk&bk%ӉrO>#ep*Q1m[ӸVÇc #MvAmxT[-"xֵ]xh[Ef]Ig{ lYXHEPܒRd9u(*by`԰cz,56$i|u oާڴp_)Ͼp*=րYѲ"Co94TT܊}E*>dRİp%|2/& L!y)Q ^6OrD6`l=+ZKoh,;WE^LNϞy$oGCrMoIfi CӋKR;$נ>鐁RWWpk7}<7O?Yp܂=&Qsi k,b])/^̡l&U/(%]oA}Ntޞ[04͞CW"k~'E9ŌHnߊ`zyHWͨ|\j`URj`NL- bgxmzRUZ94v lTjV(D"HzJr #Pq2EnBXEH#( n_:YOrxS})Zᶭ`ebj٘ .eJn4}`M"Eo/B |[X8w`/x<'oSuQ)r53YxC"?*]H\cPܞF.x3"OIjz@g֡ţ;q74OBw@+SX _buY> D }m~mw~ۼ- IBuQn)ïͱGRHe_g-uRRXvߏ: Mh|a✍ ʃC;E@ J%QWٻL7 (` `o fATxj7+SazOz?^\Uj](~*BuG\ 6Caq>9{?&̹ȡQIKeU p\\u B &HK"dֺ+ 5>p;'˧FPQŠҾedPlLOEyU/ 7*\eiT9}ݩ`IG%@߬5@D4cVr]G2yK5e OpTחwdZxVB^`~&Ыr{K%=v-YA*iB6u/(yq'qZфF[MM-b5EBM>^{qD6K1Kv$s$Cn7g=d+e.bB|MY POi8yx'-y y: 4PIob~1`cCS}{Do|;Jx꭪-}BfA^G o^AsH5۶WPlrmkʰRP,&;-|N*'K3|;?H h=c@O`^h1mMׁ!s;/bm#njfk!R|zdKLks'QtdIOd yy;a`'ﲦs@Ԋ(().=c'VsEEYۨ-灾A\A py>ZBP'uA>ʌv%Yi]OZ;H![L D"SH^/$p]{/,BY+S/ޘ<mo"Hn F^򳊖#wZf$8Oc$,Gg8=!`~5s˔}*۰/u!bBt-FusGu:<#Aոml> +8ϓS>~u?B_IKzy$WlH5֋͗*6*3㢫˕e6[)noaщtdB(fByx(ñZƐ)jvʷpӿ}Soϫa=%X8_\*dD{-"@ "# 'DsU!uXR37JK#p ɤ[K}:;vĄ>m2~~Q \;2zм$(jw$  z9;4l))l^ZCэrdRȚ#;gK0vGDX?PO,DùkfnpmOFx/\J;:+۔~Ug0?KE``vd ܪi5NbofU=2z/^blB=i- I<<;V z=bO]rt^㆖s~ xrGQDADg%uTT)1j^PbVRn0z %N.g0ntAp#_]B`7=鎂+E{ ANpEȇ. L)]UekjjDǕM?!j?sGk:Ͽ%LGCzOҌG`7MvSvgd~/UMRw _ \{#|╰VPؿ`;۔ OBN"`{/ݭ;&eE2:x@.,w&HD"oQH%trIJs.88| |_sw8v֕dgcP7"D^`A CJ@Ѿs"8ϧ6..g'n`4gz+c9γQrT8%?q`/{L7ǡn8L#h+5M 98W=.{TBFoOMC!=3ᗥPN CyO2jH@O:bù*}1ZT;DgI^!!\1(lrRR_rGD<"d ?+2k{gݣr*yeפQO?\}>L_6v3|Hxej9{בL ϥKH6<1{=8>R'悎:dOtsVVFRֶGrbϜVړ-k%3ߡ O"@,L-ٻa';A Lzط+#`*hw,bYB2y<^u4[P`&AX?1LPn! ', 8 QFɰ9hYH-'7f_D^K+Ux38|f:G)B U3yl.,0 r zEk+ ) 5mX~ 8:Ga/!`.hx6?/>A'Ӿ)F) ( ճ5Hhf#?ZHU']υNd-O橪)8RG.mO\4t)lu~X]}Z'E_GmK :.(Hm3툘֦sTEn`X_|.x񰷻E1c`Ns>81^ӷU#=AI&cv-9aN"tƋ/K}U FF~hj.ByU9C;޶2h6p&2UޚOV}Bb02\R>z!XVzx.NG~*+@B4l4k.% :t$7ȕ.\p'+ȌNN4F$c̬IW1oJ{KN8>,&l89zu]_x͢?O^\F=vb׀U͵q![ȥRIӑD^bV0CқnaŻ2MRMͧH?p!~e߉ 7Mޔ9 j̐uʄ ~NeχwQ=Xɳ?uX¬]3LRABZnGM "6Bsn3/xTyjD2qa^DbAvщ5,f݉Մ ͸7c?g z}r$hK^\\U,+"ܿ Y0{Agb$J7Vަy3 h횜3ыG|$D5je;5u/ Sd\ W1]{k/|$h-wzR.9#֢Q# b)v7&%͏]1$tӹahWz3_Q|#!nY2 Mx_~{>ayPwrqo+N[~k ?TҀ=!O}l0Ⱦ UCYӳrV3Sls͓p]kj:(e3]1~`1ezdo扫C]nrW](szY&J6F-2Gp9k[w^y%bΦl d |Znwau>FB v2s~YȵDe vv_ꉢICM֭ VMx" ։.cZ'7&,nsߛ{ AxSADw@;𦌮 N)׶UX»Z Z M ׌ţ& W&Nx#g0M зFl}걤Ps$( f@Dzw\}:7ꂻ>bK6k5N :)`_b~{ȝp%%^~uAzõhU(w?yxM T.AW 4zi܉Zt{H}C ͤe}E¨1%u\ OWCCڊOkLfoεdhӞ۠"t)vjG 59GGU8^H6 p]2\~Mljc[ڃ/; ق"ӯUꨗP(J'8$x{:dK.#-"ww`no#zd <. LP")1ϊl׫k(<>EL΍Dz,F+gD8՘G*^ ـ rT% ]jwf"=5}V׼)()K!MUTa)S&-6,h 쀸g Uqu-= c9Ċht= iNJ_q0"H~izS͞+cEPCIwq`9ZnrS<431bbe)e7IQ'ъF†w7_ncLuG:ܻoi'n;̢#jVFξ^0]/r@Wj(N+xZ:q3=e't\I2WtJv:8͙_[#ڌ9ө#SY_2o^8 O阐6}wPJ;&-{|nqm!Xv:J h[jdP2'8l-qK}a}:5TWxPAnZ PNNR}7S,BZ*pl_M"h,.)MS_@\Fbz%l]#b[1q-B2G/ b)r)Nb&~@bdxI;I< &3 "ҳD2Em/ECSD<16mⰕ)W ^}ʮ\]bRȎ15I/R7x (=s1"Awq2@b_;wX|qoyh9bӭ09^U݅un$9UD2C(PT p7`|_Tӓ` £b1H}jg|w+ҹ,uXUg钦-qEܴVa&遀w;ќ3z.w37,:SӪҪSocDoܕE5vxu'fAqa"\*6u.&:nbacgl9NN74W2H-FӉwOd.Ǖ}w^WL1C?(eKTuHj"sD̀ɶ%̲ZT"ZJX ctl{)Xv^3|{P Va^8txmM]/Zn=Nu%jc)5Y6OE4N)"zcF`=5w- g#2PFʓ@UImA@4Y9u4 ; ?B$%䰈%XH,{){ŠUj@I2K%&ĉ+]yL4%(T4m]E>ͱSya_]@CΡNGZk.T$ZbPgptH*3efڀ f9rOGx?fBb "T#-h#\;uW1x;CʚKxOb'uź5j?W ߿V[r4u+\wkɸ3QEr^do?.&PzOIK*}z endstream endobj 60 0 obj << /Length1 1418 /Length2 1541 /Length3 0 /Length 2445 /Filter /FlateDecode >> stream xڍT TƪV R?* $+;ȾEJ!0&XʫE,KU h DR `[$V;罓s&sYXO@|qe3!g9L()A&4(8$I c @.l.`;!p iNE p ̽pi&I+ ɁK ` äI: ` (BQ*&I3P(p+@b"-e'#Ԙ4s@$."0!A&R!DP) 0q9d*7-bdX 0b@J$$P %2ʇSaT'Pa`?@)C%Z,m}0`=7J XMp>iPL(ʥ"G'0ڗA# (b?MlJR h *TPt#޴hl6$ (F{]r#q?*G%?6WoS $5\7bVX`(ߛo3AUWt[6pcx@fW'a0:q6u=Lq MH}biBpJăԃ.)_[%]>8J&$85:#BTvԟ %.JDN1cKP e{lVZ9AMQ҅j pv8<{F(}qx<ΦvT(u,&T ة'hڑ:@u[rFK mԩ:Ϥ[}Q"o%c矗y*l8vy0a/!naMꖞhc()}ƿW{k/bLA;>~<[9xenoI&lg]-jzZخv&"ߏCf'?16Ls9ݤLc{UYS͂U,ˋ.5l\p %+G NxK ^еب.<b]ոf[Ǖ-Mpϵy+˖y,dM!!>HMUyשwseޙcs < 9X1|[jZ2=N7AS9WǑJlj~$MS+֡[h9G|FnReJ᱀y!4@S$ %Y{YuίqK.w{IժDxGk{Tvl mIn^k ZԔvYmY=}׹=5tߒk=vZ$|TK\/*dx_ڭg"2Li",Frv-9[?>s~,B+ ʄؙESEnpesTgZ_Qu/_ڢ ^'6}`Kۖ_|Wݝo0[rKå!b=ްe!WRNxv{$-Z{xhwq$2'w{pc>71f_:x; cs{}(9KP]E[%ZYtxqmw0X.1yV9 zoipŮ3ޑ펏ynJ0TݿwU?{ha{ϻ%܄Ȗ֎ቇ/ļnZ+g'Yx~'ፚy"Mw8&`㇫+ /딫}ѭwލ'sWN]xoZrϥ5~/,j3Lm/h?샫kzj|ߪ&32䄞I-/cvN*L}d+_+Kt8ݛcS#?An ۢi,y᰼pi)v|y(cJ_mЦG3O/7ۺDt`L\1]2 RK\Y͇NO.s1nIR˿42_i8-STVދ?ytкԤ endstream endobj 68 0 obj << /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.14)/Keywords() /CreationDate (D:20140304131450+02'00') /ModDate (D:20140304131450+02'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.1415926-2.5-1.40.14 (TeX Live 2013/Debian) kpathsea version 6.1.1) >> endobj 2 0 obj << /Type /ObjStm /N 53 /First 395 /Length 2371 /Filter /FlateDecode >> stream xY[s;~#٭XTQ*cHHH !K8C21'߯=%&l>XHn}_5L 3/LdJ82bJ31lբ.c3 SZ&!XX&teLnP. 똴&tg2&L{Ȍ6̐"QhXA3CK``cig$3v,+zfUw``AKM1ghSNv6m  et %$(9z^Q]~3~:;`2qU:,/'0/8p_((2̀<-S,'p$]Xp/ ghtc)K|خ?YU wE.00UkcP=ɋ)Zޓ'>ԅe~: }=C!ʴVIL+s4!>JXqQVBfa#f@< Lh$&ƩKIZ+(/.VkuS MZW]Ui[XVNcȟ]d[H"rؑ%I5&ZvZII?)<~N%vAATf隕_JQ"If)$t碍C @jI~UA]6xW 2yQekIh"[hwpc2模I2Avc+E&W ՠ{;V_Mw\ %4哌2VϭINÕ,#9P޶ղњQuKqL'CeV jp'9@ QAyY 䣌*dq2qzrdXJCS7.ŮN[CdLM!ſR6:98QF2kl7aR 'euQ4BBmob}q}:Jiϻq*=חVֺ)rB^;VOhK[XݎqE(!>Y]H9CKn/vc°=mk"FeO4B-:AI[wKDגZO%?Z˂;Zm6e2bkcAIWZS^-ƫxk:T%gYD٭ګe.y9d.owyehpS2$wٻ Rѱp;+tu$/ꛧ9y1f3U~n^Ktt}+~[_jJ{z?埫ԛF\GJxu;s^=3w|:YamY"!-cte!F@q$xɝyekT-hyX$lCˋ^oD@ RM@MJDwu@_D 쬉ϊ% 9ܻⷸ.?}v7N.ʴuڎj"^yvJrSQe./[P+͜ #61(+tnPO(_ɧv|EuD6S`ѐuofգ*]U5#\ps\E PJ_.FxY'=A9,a1t|_*@\OFtQfhskrM,V)Guf|Z'|YVI Ir0nx!șM,nC٧*> biYefpGi/궤2[o]ZmѴҶvjѲ6+¶[5|նm6p/^-z &mo]ZbM7m%jViYͲ^bn8+)-̍퍷ժqhy|X2m` uq]ο_4SFɬ!yV#~R-늊uc'n$PfN`Zj˳{l>JxV;zw{7\u"G]Q 6%k|mF" ] /Length 194 /Filter /FlateDecode >> stream x;NBQᵮ(o/ Q|?Q 3qZ2&1|sٻ8LDY\!5ZJI`p'pPyUy؄Y P*75؂:4 -؆6XoZרյfQ{)g-Qv1Q-w~hi endstream endobj startxref 105206 %%EOF NMF/inst/doc/consensus.pdf0000644000176000001440000002751312531007322015162 0ustar ripleyusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 490 /Filter /FlateDecode /N 9 /First 53 >> stream xQn1+2Y=B!"EԅLѿLlP5^T5R@e%` eS݈ L ͻ{`s2jg2",>s^yk޵Iafr <> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 12 0 obj << /Length 8424 /Filter /FlateDecode >> stream x͎a}_E-h,-al@u/hdֱa_DEjH&3#dfUw >o~Scǥi\mn>>ӷG}__o}-~>~oC߆icޖn>~Xn_bg׽9umc98bm܋ {zMã]_}7rM?nνKח2~4v(<#z=ƺCޗ{Ǘ0$Y]ӧ_U_?'W7<_U_?SzY"UZ.T< /amix _gxˬ[Y(fڗn/+ek=ݫ*ok}Fo?^yu| Si]>ux)q:^ zņϾOԵᓗ^l[(Եq_ yeTlx\׆]oN]}vO>}D|Gx;RL~mx9=mP qoNa w)L=Lôcڎ.~ćӑLLJʉ+-< arnCxHʣ5<\CxP&+ذ~鲈W1<.}iol\B?ܭ߸~\aV:oކ'R$B\yHq.)>Ԉ⢄(!.J⢄(!.JOqqC\7 qqC\7 qO7qqC\7 qqC\7 qs qqC\7 qqC\&\”Sf\5EqQc\5EqQc\t#.z5EqQc\5EqQc\\5EqQc\5EqQc\Zp97E qQB\%E qQB\%ŧ!.n↸!.n↸䧛p󍸸!.n↸!.n↸ހ↸!.n↸!.n[ .~uqC^7 qCb7D |N&'G'G$'G4'GD'GT'Gd'Gt'Gs4ȓ ғ#ړ###### cA RcԘ 5&H RcԘ 5&H 3AL#92AL#92Ay AL#92AL#92ALP^-y0AL#92AL#96AjL1AjL1A>w&ȑ rd G&ȑ rd G&(O$3 rd G&ȑ rd G&ȑ ˠ /&ȑ rd G&ȑ rd wk|HC(CM5Ԙ 5&H RcԘ 5&H Rc|L#92AL#mk`OKxDZxQ#H{s€郀y0` #Ȁ92` #Ȁ9"`kox5Ⱦ9o#Ⱦ9o#戾 su%LSc05LSc05΀92` #Ȁ92`>,i{;py,À92` #Ȁ92` #0|yk0Ȃsd0G̑sd0 `G'RZ*V, `UKXjt+)VSXLb`Va4*)VSXLb0 `kLkb0 `+)VSXL j1`j ƀ1`j ƀ0G̑sd0G̱ 0mc<}0̑sd0G̑sd0&kksd0G̑sd0G̑[05LSc05LSc0;Ȁ92` #Ȁ96My,À92` #Ȁ92` #X^c-y 2` #Ȁ92` #Ȁ92`% ƀ1`j ƀ1`j ϝsd0G̑sd&<a0G̑sd0G̑sl,0G̑sd0G̑sd}̀1`j ƀ1`j ƀ0G̑sd0G̱ 0mc<}0̑sd0G̑sd0&kksd0G̑sd0G̑;Hƀ1`j ƀ1`j sg0G̑sd0&< 0eA<0G̑sd0G̑sdk0Ȃsd0G̑sd0Gl8/07 sC07 sC|XXXXXX--!ArDrDrDrDrDrDrDrls5 #######c#RZ*V, `UKXjt+)VSXLb`Va4*)VSXLb0 `kLkb0 `+)VSXL '8-05LSc05LSc| #Ȁ92` #6 X>Ȁ92` #Ȁ92` c`y5Ȁ92` #Ȁ92` #Ȁ[LSc05LSc05΀92` #Ȁ92`Myl`ˀ郀y0` #Ȁ92` #Ȁ96X `^ #Ȁ92` #Ȁ92`odx ֝f_ɾojƾojƾ7G͑}sd7GohǾ mX-O}sd7G͑}sd7GoX?Xo^#Ⱦ9o#Ⱦ9oo}MN75M}Sc75M}Sc7;Ⱦ9o#Ⱦ9^Ⱦ9o#Ⱦ9ocoy5Ⱦ9o#Ⱦ9o#:UȾojƾojƾ7G͑}sd7Gͱ7mcٷ<}7͑}sd7G͑}sd7&kk}sd7G͑}sd7Gͱͷ#NoU|K[jRZŷ*V-o:o+)V|SXM7mMc+yo?+)V|SXMb7Ŋomy55XMb7Ŋo+)V|S[ťƾojƾojϝ}sd7G͑}sd|&<}}a7G͑}sd7G͑}sl-߼7G͑}sd7G͑}sd|۷75M}Sc75M}Sc|#Ⱦ9o#6[>Ⱦ9o#Ⱦ9ocoy5Ⱦ9o#Ⱦ9o#۱tTM}Sc75M}Sc75ξ9o#Ⱦ9oMylo˾郾yo#Ⱦ9o#Ⱦ96Xo^#Ⱦ9o#Ⱦ9o-MM77 }sC77 }sCo9o9o9o9o9o9ǶǢoӇ|}}}}}}}}˱ŷ5[^[[[[[[[[M cw|Sc75M}Sc75M}o#Ⱦ9ocoDzoyo?#Ⱦ9o#Ⱦ9oM5 Ⱦ9o#Ⱦ9oco ƾojƾojsg7G͑}sd7&<7eA<7G͑}sd7G͑}sd|k7A͑}sd7G͑}sd7&ߦ>LM}Sc75M}Sc75ξ9o#Ⱦ9oMylo˾郾yo#Ⱦ9o#Ⱦ96Xo^#Ⱦ9o#Ⱦ9om[jRZŷ*V-ozٷ*+)V|SXMb7647þiT|SXMb7Ŋo+)5`7Ŋo+)V|SXMboM575M}Sc75M}Sc|#Ⱦ9o#6[>Ⱦ9o#Ⱦ9ocoy5Ⱦ9o#Ⱦ9o#۲tG75M}Sc75M}Sc7;Ⱦ9o#Ⱦ96My,þ9o#Ⱦ9o#[^c-y o#Ⱦ9o#Ⱦ962T|Sc75M}Sc75M}o#Ⱦ9ocoDzoyo?#Ⱦ9o#Ⱦ9oM5 Ⱦ9o#Ⱦ9oco 575M}Sc75M}Sc|#Ⱦ9o#6[>Ⱦ9o#Ⱦ9ocoy5Ⱦ9o#Ⱦ9o#戾~r_Ƈ!_Ҧ-Gzٺ2>?7?!ubxCCyx;clXaء>v\q?;Ns>nyi>vϧkz9}>!mb9k7ccJΉϧOS2`܍j*sF|U~9/jn-~q[N^}>m<|닱 9^ yxr|>Oϟiigwn=}>!y_C?SOmC?Ӻuyw<9ҭ硟shٟ&!kxW|gru7t>wC+ep>wC1TgTwCnVc6S7vp|o08(x;8LqvpVv0vpZCJw;8L~yW?޼ [9!! n.Ezv7K\^ʷ!5monuyWr;8̰uy;tf_a^Oa%ݿ ae/4Nvp`svpW כn WHvp`G)G8a?&]v/t5秺{p,n'x˼ 7kQ=5fl<ukQ=Gj;kiQ=Cx46m:nx8;m:8uۃzlqÅzUߨ~q㷕סנg57S5S09_^5+@9{fYͿYc[fS2MئW=4cv#mئ,m:6`q='-Nqئh:6Ut\ҦzlqWڎM_h:6? t\m:Dt\Pq==Oz905! 3W׿o6ߜbτ7[M^x%߼5w-׻kt׾#?_sّO[Es.\._wܧ-xM<ˠt>xg0_NC9xN?p38۴ Ƌ[V%ӝ_n~b}ps:_S੏P,}|YM '>缅ˮ-}&3xoSs^.3lzj>ʻ=@7].C9<~(@}Ky+c?_n o m;<z_2v$%t)3׍pQ~|@bO`O aLp\`_K+}ఔ^h= +mMwxi; W-4<a;ϟgo}xi<~4 ;c(mK<^z?qg~endstream endobj 13 0 obj << /Type /XRef /Length 38 /Filter /FlateDecode /DecodeParms << /Columns 4 /Predictor 12 >> /W [ 1 2 1 ] /Info 2 0 R /Root 3 0 R /Size 14 /ID [<9954210d3d039aa44329490577498e8d><9954210d3d039aa44329490577498e8d>] >> stream xcb&F~ c$󃉁Cɐa?b endstream endobj startxref 11798 %%EOF NMF/inst/doc/NMF-vignette.pdf0000644000176000001440000172513412307621211015412 0ustar ripleyusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 4950 /Filter /FlateDecode /N 98 /First 792 >> stream x\iw_o'Qa$$۱X݉*IlS$,zɯ}H٤B.ކ`9fT2+WV3ό,0{Ϥ`Q+&%rtIͤI 6D$Lzn )Q/2eaJdzȔs0-^ҡ1шLgQiFTd;iɌpxQKkf1Ì2<@/1HWU/ fKY'1-^FGN]cSksEfY#y?e~<+8u+,2KWd,]YR͝YS S)AE_H{3vG<=@)ua*oʋګ=hg 24WdbLq}K#{$v~PV+|:GM粿POͮkt*؝yB $)N.u|Q{@%0҂tW*FK,[jr~w7@AIUNR5p:_* 1-5IUr RmXpƓqJ>-&ͤ ]׿ RzHbr4݁ VU{Pít 29T~D!r- "P;L3DRz_kDh74'1jj֓7jc2YFL;rU&s調PPK/}ٳsjJjW5nڍ x޻r99Ujv֗sJư8N$}R'Y˅X 9 F/PMs~3*.J EDVUqsy2j5Zbk;5g J ͮ(kح2` >%slCl-+4r` W NiK!)lsV Vi,F01-@:nզJBie~[KǛlZ3ƅ 5l3hcllEc49q23 &&*``:C i{j1+u!Fu1cZV"ݴFH=-vQ$nt^=:6UIhY$2}%A.Q.v4"- "-˼rgI%X|'_fmlƚE< ¼zvY );6@kZaZ$R4vEp1%).qvPpL%/.v~R&_vx;rjđv4@"n44C(R=!!/o{Œ7> Q$>u90c jnsQPm0@ mxh [`irMqo6/ ` I\g4n xLYBsNK80GgDVpQB#mtkwMY9יtB,iXXBZ~;Dx=] <ԟ~jPyI&SnNR:3?:3LEg*:SљTʾTLb2Ld*&S1Tlb3Lf*6STlb3Le*.Sq[?b~{C^lZlDyEވTڈ̽{FfȃGq'Q)L@'Pv]s)g3UsHæ@C9av k'ζ n9U:"^[2t84IAGGK^yҒt 8y %6'Opeu󙎗k ?u=tPw/C!Y> O%U}7Gc[!x lqX5k׬vo^Kmږ۾/~M/6+mSm4գ n󰆹ݪŀxJk S|f)&szC?)Ìߢ]! av Y {A?# !EZ6R9 Aɠ{Ej.6_v' HB"S/EGU }7%` KT[ZijRȶ/ޯj 2?P IiwtZ̖MI81ID^QBă. btB" ɀ#'5I l:V)O&w$:*cXDD;2yL6Yɦc(M(OHt,>~!BRGMhYbZ&ݛVyn-R4doS_=/ R(ʘz t&ip> w!\t/8ń!}E9ua1VNvIF@qJWI2_VF=RKusЉ2Jg/ƴ]#tXT'S!U]rd4iDOnHQ\> Ҷιv-cjNSm Is~ws. F4:=W%7,fL6-Pz3 B̥Ft*!\2Cֈ$4,e52) ̹kW{el4ؔ"A_f.mn^Ǣ9kO}76ilO3V9IZ9m.h]X1Χ;bB$Xۮ+}-Yڵ.bʳ{ָTS.IfJ򑝢` 7Y^q!~&wYһz"<WI#H-:kAh[JT-h˵s TFg]z;Ў32z{Ksk u涡#ٸń&~O)?+ w%? +^D_5/z{;>C>|G71I3oxs;k|)? 7w=>/G3G:pLs㼤pd;R4ҙ4^/k+?vO 5~dp4o껷#%W Ogk"a|ro%|콐&@@+n&DiD*+kqwDh*p^;鍮Y.'Er(W=:TNw)[zQeQԟ6f /:9WyϹ^Eremc#H-%zA4 ]ˤ7$ymw&vrIeTa2h8"xA8dr{uvݔ3{^^./ }af1Y~B:iS`\*ՇYV=UדdnO'kGa U~A6p0?Q)vKgR;O'@O 32æ곛Fl_zG K5`7[WCl2nUlh)ܷMP Mg4?O +쌳]XRe Aɴdr7h ]o1a_PEvlm#v@ =G.;Acr>zE.wK>Nݣ3-lWkɼ&dv@qb-k+*kŚCً*̗7c!ѐa,ƺ_^罻zCeѳR~o aEXF|lf?M>ㄾK([{BI=\>J]RE{B8AbOH)m]>:N i,t6X'(gknLx=׬a T{^49 Eweg0A7a?F;fo]I#mTHU|G '104>]9Lj> stream xZے}߯@)/d2Pq$%r)%aZm> @B+iSr\TIAOϭ/ x_x>|!"O$Q]xBǾڋq/T gy9񬭫aj+~7ي#56f՟Vi?cN|o!?R^sL𼡚?7:o$iBDHשKSf5b/b 0fWY &-3Ǐ)jKUZq z E;\mPr>ߔm kӘ&o]xo8.%0A]#J\ģNHq-i(M('C ,b? 28rDA'g{R3+;06EFKl14۹b/lFa#^?nlgnګ_4Shނ7~StPت,&kta?p\CWmUʜKeON#쮙p]CsǻWd{ڣ)}wx^nWv#qAbJV Nai4UE~1+{n=stgz5AM*|x6 Ms#6+Yv{!Cn6X(YQT4m^n܆؀[<4fY#I`M^q;hm$]BMlcg-y4=[7nmra6u{ ;[/Ǫ:s+u,*/rH4Sʬk1kɡ p!+k3ʕk.B>7sG7\2ڭ:K|t#bk}N|UHXtK80Y*E}/nEi02{00xTǝ9?{3aLY^uKmj]C(V\)SF :sw;KVGP7Myо j"L%f"_Qٺ'&p8EnZ. _e-(8(Չ*A^iWמWzCEw" C/=iw?T6>XTl% 'Cc΍( f+rimuVK@ % ֬:A)SMp.ߡH!TX^*ZvfPE qc[׷u}EoAJftF┫a#nqIq xAx_À4=[)'0ȐƶbDV@T~~]3NIzv\-1;G̬)`f{n*εȑnSIomi''^dg S71AHRca?Z9.QXn BdfB[[WDЁXwUB+7jNjV!vy~qYQ+:$*`Ɨ%`}QXzr>i`Gݬ6‚ /1Έ9'elyxhz$ i vÿ5sՎ[Y?M=_>TOixmd&Gмcp).vQ$у 21kyO_96M W=PD{"x7P/̗kr8GG$K,)qJa*bim8:m&*HYKv9%ȐӄEރ8.rB5D ׇ|ĬsL>!*ЉܙSV9E~]gݯ0+ɒ`hKagq,~ O@}J [[cOtS%)@[Q*'!΅ArAH-ϭJmd+α{*q߸@c5&u0 mm# RܟHvv<9x6w/,o|\^~~!AT:!1W!(`i8q_:qc1R.EQj!cTwk+ժ!9у g"q\qS2!Id')HXCTmb[CH-j-]mW ~Ki[umQHvدmrsmnrDW_d to_p*I{LXt|u%O込D)L7g&""Ē}ځ;q h'@SUòI 8)HZ9'./WuV+V.J H v|{knn)YcˉM%s,i܍ww*E'2vJ&n~K9{D?!_^./)XؽOyͣ(Ia$HnD?FQ_endstream endobj 101 0 obj << /Type /ObjStm /Length 3522 /Filter /FlateDecode /N 98 /First 889 >> stream x[koFb~MS'6mdlwAh${aٖSJ "9;>νC &fz\ AjWǜ6z|50>2^ $dT,DYTWâiR:"J-SoITJHA1QP]bR:P:MU7@*QQOdѵ`JРZ2% bJkL4S.A^;Ӟi%N`Z &`y3F8G0Q$Lc Scˌ!cixl$1$Ni$BQYG[ln,sF86 FI D 9 x h ̇RJ< \dF0Ivi 2dGA;=-g18E&L%T#,% HrSd2H_TF4&zd 4DDp$F4:aUF"65I]FGD"#ۍlL/`a9+q f ˾GuTSpT.jFmmiF{i¶&*>4ӑdQ]4_ah`4Dne/FuW ֒{Qy'G,{_-Z&<-aO>?7QQ-QŠ$'r\uY%Y'ߌFd!iE!+K+bR/7F?y|4z\̓_Ik C] i?peȏ{b5]i"px{ӺpRz3e }$>*`}gs6kssz#2qwk9y{7I]k&ܻ\mSݷPn csnͣ9f^lb[}$hljmJsn -/Y\4E,\IYfRpHe}GfK_<㲚@Vz GXqN19y8sZ4&D"kbSo(mx=_O 8]v: @9=’5WvO؃4z/1|U~SB O1\G4_@L2yFYXGv2>AÃNTuk AFҰc0{q@BA⬬棺/za^icpxNݧa!, $cF s+, %v0 2IEDO?./˳:;kBl{A%+(Vjjh A]fS0)Tbޟ^cH Ch- шE1 @rj0Gf~ʛw(3${eR)9P@/;A6EcnqH]olR0nzou˚_,WGG",L8!Pk°M\&.x̆9ː}*/9)8Z&hgɥ6Y.lfW%B!`= .5SWxH<ۿEܥt8|͛`%,(vι0eHܶpq1p+ G(ۡ^f%O_)ϭ~|, թk[z^苽湻ƶ\W^[ۦ1 ]I8_`{OU b =-'\U|-LE_@"GI6 vvv\SZ80sڗhs<IQ>!Ļ SeF CQujPV ;jSKavT]#f߭Uwg]dy,XLG 9}ۧ>$ߢ e yitbY\<)r@,Ւ!h~^u>4&d\,Vw|4^AԘx5?,EѸzZ=G1>mY,Y1&˪d FktT i1ƣDyN=Cw[Bh%Ll>`5[ 5)l}FkW(;"w;4oSBY``+ pGVXR+ЩJ9]`!^li#Bz`z*1\cՓmINSTf8z۷j(5__5p`mٝ~:h ߦ{=@/o%T< QNg> 4jRhTGPn~-Roڥ_)lZKp@^~ĩYmZ2}=M=O[ܑBb5sfWު8>HT슣R+jcJXSYh{0 FE3B;f^+I2[% e#h+o1zoSr%ܮ:F/7w=X&"Y^Lg$el\l<1[deϖUٲe._Dg>LȎf钵7>fŀfSKG5/U,%OCףY1>XLј:u:r޴->8Ȏ oiVd?%/wjbU5a^?Uɪ؊`hX˫^VhlؔB *7vf#oyʲj]{{PG5֋6Y/v{b$,{⸗+6yPx0wfMK^: yX7ED#7JId]!ʒ")wA"HA@M▍7]1?8(endstream endobj 200 0 obj << /Type /ObjStm /Length 4493 /Filter /FlateDecode /N 98 /First 904 >> stream x\[s~c2/N۩%Gj;q,ߚN(jmHbԒ\F+RX,ù`RB2PL*fJ\ >jWǜ~ykq ,LʀdRk 4cJͤaS25UhH2TLj [fbZJ3Gt)˴'c9 O}"3İFGHfSxAL$hBSY)&l1| Yg19G\guE{RkE#ƓHO'Z|>V RB 48$XAOy>Pw FN(AkT$5rS+:II r, "R-F Cmҋ<%xC8@S)<!"zhE A+R0@* PZQ0hH@(i0qЄ9+氄0 0>pyhCS @L@D&GY9U@ p ~ß`^M' =|:G|qx>Aܡˣz>.YK?,;e+2_򳌿-kz]`=˵Ɂ~sxXƺmnzNo?yzsLg~eW>~}Bt+̋~s-#;܈93{~ٱJ6g9hQ}Sr5XJV[)쬞2ʼns"P0ʓ@ Ntt>|ؗ[rpZ ;گ'{U0b0@.k𕹭N-n1Uq * Q@bSE)`,|=QiW9 62Jc5܎t6ps5הD)LQn$=t<\5+wOEJ{$)+Hm!%&;PLsCIlnBJMЛnHztsݧ ?1bXԳ +#M'5 xtN ?q<']<0*Er-e&?'xBl48~.J"A^0ލy1 ӫٰ Ԕbތ'ytR+fC\'CHڇp2G"DB%ybhAh枆vdVxo e G1G tr՗koMqn{Q©]ɺjXJTT%vo?q> &l/ಚ>p#{p|̭4Ab1VZXjo^{LZ H -&V&XdkNeӟrsU >QGj1{GYǡb"TVhSu:!Cs>5V|q1)Z*=N5(ٍcЀ, ~ʖR0rKlDovMR6J`J$Bjc\=.rC@ai/KM슆~! Am ,mrIܮw1 aB\deiRp>—~azK%|GHmzs?*.q.q.q.q.q...kq=W?0X]GXzX_X^DaO:}"'ZV!0eeI[w :=^9<.ֆ)kl[b۸ p ܇+<>eRJza2e9ڲ]iw!7Ij5Ir|zos95*VFKj &d=wqw bMpoKίNu *>yxzcM)`*Q YI%ceC\GYiJ:oCpUdK\`UPz-уlw f[i/H>UWN֡ }-+:al頗C:bY ̱-vㆂt9W ,u^+c:z;{}Inf5gX*:1j+RcDJ[J#!ko5ת4ez_:hb%#*w1}X%r%w|v\oK^}gPhh kqÎ };68wLRg^ll#3ښ~KD<ΈruRo~,}bdڴ"5,BJńw|hk/ zw?ͧ _?uHJJ\))D%_^:>2SV)}"tZ<֮ K@hgVAX"F捌\_.&O)#' +BVv|@̺VV4у^/NAqoFudN*J!H+dkF:3s]kd tV]+$V@'Jv\Y =mfRoλeVI3%dRB29GçCVoiKEC FxiS,"# Rxgt n!dz?1"x:Ayq1g옿Gj?zg<'|?1>8gч 6dgr5`-Uɇqg|}>/|V|iʯ̿׳鷌}ƃsV>>:#\&i~=k0~pQo~}GÇD{ E}#Z]єrYT͊*n2yH{pdYvVYr,~U('m/v(S?~կy][b2 א:<{pua? f^4z \{J8-MuN;_ъF n]mKrllkMgHۅ] Runn?;."'/׈|) cUΣx/פH@-r Y9<{KVr]VׯQX&P8/xaD8LY'~!Kh;d{qܴ\%u,Z4j]kWgs?rZCtS>-kkA r~MlGXH &}AGh6@0 W1t> stream xKs6<ě-qHgtldN$q eITOX2Av2pN\sGSN(pDv|rOC߷ׁSL hQH]LJ`n*C{!".&\m`;)H̦Vu772?v.K4ioU0-9TWw EDWvvM2᫊U@u~xu>7>||DH!/&y1{,@B6ۻSޝ·՝Lnj%j,Ԋ'A8,kt_Zx P Ϗd)F\Dm{!3a#>Ǖ4H(OMgX %f|"$z'hۦPm"cmեlX DRgXzg*#y^3k!ALa4۳ǪG"Ud/ɓ飮G(68H[AoZ(oRTZ9aB_aN[mX}[Om36Hςk}ӺV$H金z St·Ρl6d 7ą& q l&Hx}w :O5A1xZ;ؤΒ. aIݐLJ2N)CvØ9J۱g3cs vO`ec4*H*{1wPK Z30i3pX ͪ<4P\ (DXO\X,P[ cpO6AK-e[HLA"6Ī3ܷ:O^jY-qY| WgqiE5'n2t!瓬rܝz2g{rz,Tm#>ɰaS j!3Ю=MGZD&Roqt)+0ܮgo YQ#C`lQ~pRAe|=(0"Amz7W^p{Ļ㵷`G .ɿOendstream endobj 300 0 obj << /Filter /FlateDecode /Length 3189 >> stream xZYs~ׯ`M, J؛H8hl'#Jv HExqO.x؂.nYI*Wˈ,WPnHTtv7f3!di0;-vyzhf(")YM-8Kij"*f*3k]~b=mc~vIUqn=k|4ܽ1]a' HT Z~*$q!n)9p?Z1劃n~.,\bRϡi  Z&5m*g,C^Vcţ7wonʿ-H`;1vz8UEwv[<ݮk:УIf ! $2ς\;-ޜg/>`%\KWDϫȣIs91;^jX9նaWgw7Ka( >}s[ۢ(6e57bYmtU>i/p\4'qq ;&Xه?ypcę Bs۽3¨Majf _~F l.UgJ}UvFg8 eUFPUUޕ=e\jc聣;@tq&5o dC5Z*uyӣ?xv{E5`mq?5ht $B X0]3qy#nL|}fyW/we<_VUn܍J= .۲A Cm1Hփ* {pPAnt1VHbX0,$SEe2(d#$bG%?MSlAt< i>~4 2IH2&"?=,Ӱ wQ$1t -Fp1an:W:q In%>]i==]09rPͨkU2@.Tٸxpm1E -5)2f=$4H'SdqmVFjm͕2Ot(8I)#f!4CQX*zPPl +ۃODIȑT*an+]tWbk;c"I?Uq"ƺ)ј.mθ犥T4wN c  7Vqc7Ѽqez945pp#0Z̳X} #噔Ap+*EB=teJO]xUqf$K' im%bƳI O@FĽ*6]21 \Ŕ 2I ?E*&M  (7[ά8mA19̳ C&9N`g,%~8y{28LQ-De8P4΀DCkFWCtQ=Uy0ۀMOSXkeQD^Ac:`B" f!Ea^O31'ؕ͘rj~OAmua` agj=uf) rw3bf|31b6a{\i|nb;3:fAdqfJjrBc,J] {6 p%u+8#:ua!#Tڪa( )JۑXfcv*)@UH};b8RF)2F4Pi?KW؄BI_sG[x{YZeM>C-%]]:x<`L:IϮ5l@؈B_HdlTZH0Q*̾ /-Lt{])L79yIWn WDܩ(B iUNUf$PLcaLĔHT{-hRx+*zA[ц]%/ $Qi恹ڣ12UPNvJ8J Z0Ihp|_Zֹ}AyCALn"1뢕 d0?NܙBA`L @"gcҘҩF d^tWEs&~b%Ŕ*WvN=KH7 (Ls7KHP*\_^/ XMt񗫋uYP`vX3 ֿhfW,n.f^Iz2sfBsx 37IM}n+' RVYlO7O!&G|Zt ֘Y31rTy4_IaNP˄Uw6G2@yT5Z_Jy+z{Ќo)){YLŞaF:_B?5n@LEg N;IJ#K r~;f^ @w}sˀ0%cn& _Pc~]} d翁b:$3Xdɣ3v\D]=T9-?Z0OayiM l"(Eё^Yω?WY> stream xڌP,4/%ww .]CN\>}-ݣeN %Uza3+=3@T^D GAfj Bb` QgLP f `f0s0s01Xc3v23d.p^Vq 20sss} lt25Z>"TL^りՑÃ΅Baj P݁f(GPrBZ]>ٛrEGe@wq u9PcptۛehlqԍblbeGƿ|YLhW~bV@ӏ{16>AVf0ssdTrrJCGft311qrpN%_Լ+pqtpY?n@?*13̬L]&@ +{??@;[yt>Ə?&-fіV7*ED<>zv&33aTã_$>"  5#(8|3@gؙL?~?/G_^_f$fk_?zc;+[[|̳n;|l5kElNcC-l[F+ +O忆?]pnkeTrp331Ι|\*.[X )no`| f@Ͽg`qA` WG98>0A\F?(_` Qb0JA G"JЇO?ç`T>q3>AL?tm/ݟ7ZkT|mس/?X~dd'^@X|Ȭ?~p(q0]'؇kG?xB?5L]PP|\attVɺz8U{ý?5?>V=F/;EI")+=! ڕ'wbDZ8XmEj5>\r\B;9J4eҘ-\ѵEY \R% z@^t<,g[ '&PrIZrW2B$-P3~ ^ߤxi;{~ݞG(*9I9Tsdk XS~*c.>C }K]~ {ra+M?(5%_&XcaϢpGͺ&r^I` Wpdl1-bعi*?i "-W +_Ub2 g~r]8%e0,l,ô޲&-bSk~ 3@SwQ2g^;GzB:[7J#lK}|ԑ PJt-.S{A"Pc FNpzyM]v)wǧ$-wmm剄X$FgɣMԘWq_^B,\EYbF'\+9 )5Ξ%AҪܢl׳1^[v^x D͟O̡D$oC`,4-gPߧcx:nlի𠿆H zTNRUGp1JJrp8?f]x8snܤq"yE#s92Q*41,9ʌ*՗9lkT ;,d;sjhr)>UZeFOlC ?}XDN,6=~I)T[ƙ %ؒrUX<ޡ<8OǝGSURY\MܾWϨQ_9:$iw}מɄ;NqDOO6H]I)Oٌڎ檳 L˞*_3MOr/ _}tX\L]/skڔij ӼROߖdU[nBk~;GKpcf҉4t!w~Wv $~mºR?pz aȝhB*t@)?qV}4V8>†XeWAķ;#3 tSvAҰQ]FKw_˾)b@'$B0mL+Tx\l9DNڤP؆Vwn$}m%;HO[ۜRyFq][Q:v[$ǖJ uD ţE;wX >]qj ])ZQ'25[ek}`AY܂AWwc Fd%ˊu;{I'Ϙ(I`C]9aX7vKCvuڄT0D~=-<[wАXiphF ˄&TSv/f|d[m &92Yͅ~络Rؿ[yAUlȒZm ɴ?qGQU`(umDEL#|aQ{j敱*'5u^Gv' `ڌ{EsbeM'6݅]<䫫eA=H:=2ǹŲҋdFcBu3\ArX-ct,wHU-B&D3=J*I@663*-=>XzQ}Z. +K~;O{};;*j~zǷo"&\sZK15h+ehVpq#Η?7}X`FWgQoC8]{UkӥrK$`4e(u[HnNu, !'wa -y 0We{mUnҔeNlcP2s{}9!Ӽ٭;4m':7BzBPc9PE]{_%<Ɍп0R2⵷J-2u#ft3##hwrZM b3XEk%0~D+7S3VVClhDfOs9 ''jJT+(< lē\ǠS<^ʈ5 7xF a 's&lg]{8mu) h"mkopKQ$Q9ΘFI?m5!dHO r6\t`z{r5r*XSm&Ei 8YK|zԄ$"8l>21*`8`@ $ԫ#.%V$We8ɨ՚4vuZ&Q;2{\:zE ] Ӗ2 n_r[pE]gB3Vf(Je5vmŨQU⫕D/.o,G|NyyNlYϳ(s,l?PCM.u- X^7%)A(S Wyk\Ay@cpNN0<`2T11TY E ~ZNJX-@ TsϼYe)1K;NCm}y"H 0p5RHRk\mO|r)R_N!p Iཔw 74Xv6FJ1< o=t XӪՕL'1U5S=z{_2O7 h-1Hʚ i&n 2.D' xO${tȄp *.QN`*reW}W4k2n fSYid~n Q-[Γ?q]XTp!/ LwNPF@xB`&pJkoƔ&2Q (:1Ӡdsp!ښPt0hhk_5Oɍys8REQ[o#2 f-TK`sV$vGmEԺ,󗩣~&_^Bkku>KNgTPnN+ro(0;or {ܿ"Oq`@P3/b SK K]9ul*,qsZ퓈0dDȆ*0:nN;>'{;V=ճC%mT$O(j.Ade}KYNm2Ub$:=bcO pFprgY"F@B+d8R&UhTRRS4޼F3UQr:{,Jd=okD)s8IltlLFRÃ*pp6C|a_mzA5rp!BSǎLXz$ȱ=0ͧ8xެUY#ȑ0smGG`˒U2}C療- jNڥwŮ\}p?~S:sa+8sN@r#M6{_o(gLfW'Zsje5'A-@,7thHRl[)])'h/^5Qm\ IEnd8Q[}(ǒ܁CxBifYVin4x9h>3\) z0ey@X}76 .\^4)k'>+ ]WMwXO-a20iPh r]1ZUN(*@q٨>ez~ͯfKo*˭|{Egƶ~, /½Et Rdyغ8C7|Yf(vW?p yy)^hyz.FZɒָE&E7;6h N4\gANh;8e:{WTݔmK2(p/2Ɏ~)O%@m;B#haFb2p߳S )s`eLm{$5^T,ADt6F.x)!S> )S_0i~|i'-|'Uux[wsRv!hƒk'P}% x"׵%:+ CC|Шzq#ZI$s$g}q-c82;EytwzF59*ԀeUu,AAcoj;o^G5mEv_uXbvf#|!g}~ ˘+<#8ٛQ@^ʼiw2R%bq;@Z|99-*,8ͧ4#X Q; P-y)} N1 %tB2h0YZ{ };s}z[ӆ د4!ere,Y'&TwNA*ՂR'c%} #b J7\ (g )<ayh'm>uߍѮ0 & y>üӡ**`ƨ |qW?O aGf|yzsSCTD$BsŰJe|Og] ^NL[k+1"2c ]p&.< Ԡ#LeW5ËVdQ^}17M0"b]~YQu$|= CzxDjygIMiDbRmΫ2ͷ΍y=&ZEM[ N*O/v.Q7ǖB_Azwr]jW3c*T\D&ʧRhP( xgK1&WFh <fڜLf"Uy& Ă~ 䡵=FA#S\ͨ7AQJL00::2a>,]>ȕZrGkKLQ{&p$>rUi/uLI(:7ahd XB) B15ׁ}srB/ ꏬ6kk'q<9&R'L^QJsǴ[>aϸ]=x4NH~+Ziیe,Hkq283P#R9cby?N(3n e۫زTWEHO&fniX3Ċ}IK)dp dqE},aKxnwdrwlj،>dEI,Jgx0F48fHׅ,q77EuqS)grbzdh5bAˌ2=;QntNX7%⤦Jy'ל &ޑ ::W[F||-8))\< V+zV+PC0 5=7&[+s^+oyIN>G⃨]^fAJkӪ:Ҷ›:_<ߠR_9Zyr!Wnd@^ V'ipA",L-)Q;K<.{v:Ǎ 9;;t,lUT–a; {LZl WUY]8/i:"}YDkX{XYˋ@Zћ lULel!*Nm+=K?\{.׶{)(/CqI=irM2{DZ#\Uv1_g ۨvo˳ޖh5S0=m_@L›*w}+j3 l6- ]7ȝԮ bQ- Kz)$zZY}WeW="`^e1Qsd*cMpCG0a}gO^}fj~r`v&:4% }Ɋ ]Xᅄ5lJк\bweC*%C\ t^i꣠VH!C7(NU'(G3ֲ'3N<1l4Xck̔d[(o6.+y 7UrPsjM"N4^ i|]v D!a:.n*Z 4{$53N-`Qrh\R=tA=C,&Xd vUuVHV({LXCw׋eiIw($Zٷaœ˺W1w7;+yYIlCQ}k;{d♂f/41۸r:_24RYBd֘z)*QBz˞oM[a)W|k`~q`Oc\ýKvbOGE>? pb~UÍt&'>okcܦjߦN{LTͶb"WIYv!㷥3ۛPYp K_x=B=~Hc`fS6d47)0=ۃ_-_2Al&86t̐/jT Jbn h3fa8)CgʈF'LBZªߨDh7_b2@r}b3mQ.8j ){vߩw'ȱ8wLGd\Dvŭ{L24PWiNҫytDF9Ij\pќe.qVV.97^4>(EYLv' rAhKj()\g[4xZgg"^|DDŽfp>f'| а/ˋiGxRc_9a,HGȞc?Y_] LYnE-wGmGӘDCaNC.ӏ'͋ q0a>ȅ6zy5Ks!!+:L!"6tVJ\93fOl^Dv@ѕ &DЈJHa`*+7sZ?#DEXC-S6}{zݥ X10۽dI[?&J))5R} j5'S8XO=> }IZ| e}Ν5=, .r <4 cR3uFbwLvY6ar\Pzg=@<16AZ٥'ƽ;tǁ7(wS78\4ޭ Ë^zn71cڅ{m©n) 759MU6]nmzh:ʠ1"4Q\> j>ߎQ } pc.\G9()oo~g&]hN5vzy%D{hakFhAoN**yr|]E}^>{)wB N}%m"FFY"J쫎B43M UċBfDr5 HX7LrZsiؑٞݼy )6sY)K|)ʴ$gƔb3mmqՍJA*lKO&sO=3ps(fB\"2tR}oOw#1;j(⋣d{kt|iO*\B} -ԐDO3ܯ*f{Nqc:PZ|QM׾/C.W9XԺ9;b V&$DLBLPݹ43\p1po/ \A-cݐ=*V|y1sѯy"آ'S vs@)rz~ ^z#/m+H` ]fZ q&D4xIiʾ>W}7{ lifYВbatO@xp#fh߯Fb1 -ReGGK \ݙ&K3)v>4&fvD`c@i?n$ڄs̝%rȞs(xr(zzJ)P>ag0[`3kI&|R,]0iǔwVΡCk!ebuGxem;P{Zρ7QkwRT.E ~TYC5A:ø3J:R-յ5/|g0Ժ">.Y;!;ׂˢLc1L B{hrl2*Ќ<-k@&_WT9-b ç4"& [.a'O!i Ν>xТs۫l>9|fbs$א;RH:uG<+uҟoS4<ٟzBs(K壞 ' !Օ[5j*n_r*(.rAaC78ԫ&\.nUY=w2k G{] kkRNWGOì_[ {̝t?KשuG?4 vL 04!#nSga0 c{o(UJ!z̕vVؔhsțTd|v_Ipzoȯ *-)hۤ6,̬GV9~123Lc=4S%mhfxJ9Y|j_# zBA&*9z]Ń{;4g?~r\QJq~i0;p[Q;9-Է[@haFu9&kg;((>paW hkΦl_Ӭx7J]W 9jnE4OlL]Xp(T|ݍЖ7Rw H9iZ'>˔< ?l~N3|$T.$ |/JsWDwϲ}j'sPW)rQ(^%Zh6~<~Myaю X&p<Rk1] 8{"E A7jؗٱu!A iaBrhJE_2T@gU^hc$]9AM{8} ~wOPג\d2AȀU߀j>^V(gGT:h`\dHFc__Y2͡FD٥ _7 $'S t[ ١E[(Oh^$6%YFՂOV2^\j"uxN=ȓNX^W9ZI\p[פ7V@b^=W_ƀ-KNt3F%U-*Ɠ.1sOC"Ŵv=Uh5 o!7[soxɂL9\Lj=46zC!TeW.,ñ '+H)3~tseIӊGMX5"-fR4ι|<ŋ,c%y݃qqRޓZhG1kё§)Jv [6u,"z'PI1e#6f11dt8a$a$^ė١MYP80YqٓyåX1 oaqʦod& #RƀoSM:8޸ޘv^2^:sl;[ruzmXo%?6M#a?9G7$F0#mջ25ywyWfG_2Y=<;c3?CF:oV;>kSI}rUmh8%U60;Ϣ~8*D|{WK|R}Qj ?g!,%(vHsDT̒\N p,c"\pb aRMz?ʢTkZeJ2ت}g1  {G|] BؒKؠva-@`ij@Šw, H^FVt&[fќm?s@eT5~GwQ{9qOJ 7΋&Mf32{Bկ8ړ%RTBO\F:EtA)v:v\ިFCE\OBY]Ke͈p%/Ͷ-pzK+rw 3΁;B=o [ҧ|.ilɍ En *?OM;2{( ѢtGɌ'C>DdиTW 8cmdIl#T)$q(JA]y58Wwb ]MKmP0}yHWlz8@tMjgS?h%n8\GCܿNvD߁րq.h` @{īv>'Vl 3Yqvq$2I6J[9+!F5'sefŚ7(\ >=\~W bHI򷿿תW߲JeȀlWnf/倧U '^aU*kD<$~6B?rסȚ6A?ʶǽ_Gl܃Zd#7e+nUEG}.vy h8)Z!(mN O xOgD]vyMaX NwVR}T5+ Ι7[:if8K@I(IKC%5!|p@kj"hCr'VѰՙې+",a񆅋ϯ(N|{mzPmxpMnQ8 ŗZ|:S"[iJ+d-U|O3vQId,,U8{'!}A)R?qCU;夼f90*1qjv hZXjA_MB6l3-lWPHĴ/sJ mu#_#R[oG`7 Q)- g)>g=tcKj4< s'dJ B鰕I݈q1tW}YZϤ]Dk^M4A twMRJjÛU#UM)V+q,$wZi1s *2^w*ϊ&D* ˱(l Ԟ6~.?,<8aS+Ii3V: yXKu -<6>>!^HdXhuSwv~liKS%Fh euUk֡@*ZvG"}vTs&v)0ni8Ůjg=/DԹ\(l- F} ǖ0J*/#εo=:K5!6QqPs 99Ջ>ݲG~-V{@׀ы5BF6 2s#(ie (8`:wFi61, pZb * M*#ÛM2Sl* $I4eļ#Jp="˴9Ȗ6&`N Ҏ\ꢑW! HHMxb'JXe_&.AM”^|Mng5Z$a{u֤K6y p6"2qG36+戾7xa*kzfJ&s/Bzњ endstream endobj 302 0 obj << /Filter /FlateDecode /Length1 2132 /Length2 15002 /Length3 0 /Length 16277 >> stream xڍPk Cq;-݋w+n] ޯtϜ3Ir-ֽ$$J¦ {;zf&3 B9<ގN ˻L n(ooq09x9y,LL1w,M {;3<{|PP9vۂ,Mvy= job rT|..< @[g{'sj:@ rr PڂMfa/; xX]\LANUi9_r29f_,v:<-f6  hg!]: ! 37?g'KggK82v ;gtݓ߇kmgndfigj SWFu;KGWؿmEd ;'7yX0@/;_o{; 8|_ 04q-D>~^>av6>bFu -q55SRDM gag03r8ٙJ@W'=_$޻"n  53(ؿ3@gؙLߘ?/.f(+p[O/=bM5AZh{voh,a2Ut1ރXځ-pLLGs&Y37kX9@'''<ߗl]]|fN(;Q/ѿ'Q0q2% f`X{L? gP/zϠTcAUAF"|?=俈]gboH:Fw?yu ދ4BYn&lFw̬˷|f23a{eDw`~/3_bO/F '?z^?ٺu|gƿ{#{xwv^W'߷b<@&+&!V!us+N]aRks6SGQwũV{5„'+w<&w/Oc M}9nFG@&tG# Gѕ Y}Pң[xA-,K,}z^`G馜|1F-E}k 7-}P"l)@iZ+b3#]1}*e!RS9"`έdL0>}#ÀűT3Oȗ+?zJ$C[4L-ТcwoQ4D^v H70 ZL1wpp@Pj^Xչ\>L;Lճl{xĀ+CнHB"EyBJa{|A/NK+1To<}٤:kաT;v׾2χQb L n8xTYAh|:|QYkY s^/% {xj1FMD 95C-he#5pBd`ۇM ֳ S L9?C/em&8c,.o3mii[YehݩF.3^×_[~[&hKFpe[$f܆Jǵ_2S3`aْ; @aiepΠp?" IT }DŅ0 NgyLͲevXf8awlͩE&!5|d9M |ӓo-|۹dv+YjJ↩=Hy%Zl@gזY-LE4dJ#Q-psǿgUY֛z,TSTtgBBRJ{3's"葍E#Ve\f2xFM-,kȂ&pg @0ߨPKzrϏvETlQhU/u6=DBוængWsx2֣ .T$KAfc<&M;RŹٍ2`#`]]^Q-VY&2~{㯾`o.[ ٸkn U5r%p髤RS(JI2 O2_/:gM$l?0(σ[JPX)53wx| ؐm i6#]gdĝbmuo/s!#N-X"^mGA+jDTro."WY+]Ajա [ oX4wA 6\]82qj" +Zg~&?bl7hk1vqQ+cdO:@JA\x{wމzB0;/]Dd|GyWEP $ Aߥ$l~PzRaʟvCa !{Q'hWulp֓iۇac~z9}Uxk KuЂ]K֮.ܳQצ{Igl8 4a%Jl4bN x f)Cu~5?,anո|2 & `25Nⵟ⾍oIWY'QyLf6nӃdZR.b~}pE,5d䜝7Z{DHt)z53Fx-bZ_MY$ﻼV6š/f=baj*y`&o} o/a8ib}=HlgTm s%+u-3i ipYONT'J׼q,ԊïMas4)F}z®YsA"G C5ӳcFDZ|R(4$_Z6Gp74[b|pp64 y}@9UNjs06k 2CfujZ x&Xсt\ElSp^G< VNnwJqdHI%Z<+*nQfTNE|+MzaGw~BuΟI1Slr#?Gk.ÐqMbybb1r&xAwL& a9,jy/j{ l+[QXLeւ:KAUF'A`paxڴߴ0/%& h%,?*?ʁ 7R`np-C|~  r}9E,3΢4󺹛aGg}" M>E6².no_b] %=(/oܕuiud[i۶.vm6ͤmT$ k!kB>ʢF~!  uqiI޺כOi?]pѸhD10lۮ&x:+x]P-8 EU)m<[沺FNT|ٟp_"~oeF4ԃ o;o؁ b3ßu& H~ ƻG'^aEc aEtҀiй%maP6"3~^ P9&N?C#c5LyK\Tz)0N[򝵽#żzV-vŨc&&d>9$# E?b3/"#őH{JtG|88)3Y#?UC󍋤 j$"Jx/Wasã9!(Tg!]wŃs{T2\:}k@>6TwU 9$ L.?P.o8Slfr|Fz [/7qX:x|Owrl.I=[;]I_eUGfyTnj dl9a~EǨXS4O [LrOXcE?Jln)`&ujx.(I{欤^!.fzO]b"#aYּ$WUpd/ڳBdߞf]o+ Fx"GNDR^FL0ڴ}朅4: ml9~C[ڗ&I5$g@QP6p=M)^Sd@E REڧ8>oa5Lڣg @cg{f ؿeשCsjN~Uk>vI38`'LW f=u-pLw3k#"XwiGݑLM}lYrQx?.,:YcPn"j48OS4O2eϒw2~q$;H -:<}H5ʅ<Ѫ1X-J0Xnm?[6sU^4r<\JtV%dm^4^0@Mf>RV?4+p7H':{ ޜ+,ZFw>uR q*])`sM=WEɛ(wgn5FL7ARH7#e@YҴNHva+.kΡHOSyTSޓƸF JVlsu 5iR8Mf :u<^Lv}N4gwc`~MF!tNf , Ql7}xhKZo$[rj%AX<-`a*k #kܜx#o{'TijE>awU$dA( \>xtFJfπG3 ̒7еl H auCCe<9$kȅ瓒oQI{ # {7ٮ4lufx$&/qt ߰@_1ӂqo^0Gz["Q~ЃzeQm|sJ{x3J>U%1Y*:?G ",چ죖kX7iT1S$Hv/z 1Ay&qbUX>'iM)/&#VF.Ϥx1xϹu,1 UVr9j`| n;E zB?ä RDZA3F[D z5WrMa**rjZ㲾ov}c )!:=)1,BKk24³{cP$˩mu!q:`eb!23{d.Gx6BܩE9˩1g%,:Q&`({V PuHA:\"M} ,OYn 'ӪTw{DL-"Qė/:?)3!e8qdB18`X)6.hd]Y H,|x]oK{>\^8'uR)D> b =*73_!p%AR`+|'F_Sиdu QX|i>r)Ue)qOKi Jl1G;*f}mR-zSpBG%oqqn4i9F9 kbm:>iNnAC0^c6%Xd 1cҀ!g|cL -ižLss*jR"> ΃CF­܆G[ɣ򩩷1ŭ(CX<&ow,pr\kLDK|Zm/72AT=$& =^?lPb㲗B*ݚ^AVʨ\XEЋD9Ɩ , ɖa4Pg0D^0i?31[gsCK}SlțPqvʉƳ|B= G1$OUf=܊G&=R_*T9g1F<ɬO0-!xtdkN!56~VŰpLWzl YFm_"u67ӦZHq_d\Cqge(T_>Zoޙ+O{]v͓TE{ 2;9! i@;:\_ܫSYb8&{;Kǐ6B)9vLb,?O,uiXAz|Ȗ^܍my h-1Kk?C` Bu5'&)03{[*({do@ĤCb5A"s`Zed 6/~+pǤ҂Đ*am("*jT8<|jGM?C 0ڎjN2[ͰcF6Hjlɛ_=ͥO-˒8IvC*4S[{Y^CTRܝA>>z'A5i=SʀhSeW$g6tL^QaaUQ/S\D 2pηy]k<;=cDŽC?CSd0y9"^ώJM[_# HJ %鏀DJ1̓`jW\|'5 P4ff$Y-0+q>'7t-|+w {=mcb{;+Es9B$QiS02ם%([ & Y^1ƇsT5{n(:9̓!ȇKS#2zJ>Nٔx.>/MV30W sNjjpKK⮡uRM_n"[^'S?Q 4Wm^:5pYs%SI6gu>9~4h_F+$>lmɂ G+x*WkmtCI{{qH(ua+`B{^](W ZĆ8:z#@ÏW\~}tDb7\JNւjZUV@wvӆO--[smƋE穫:E` SH0T.>G2g,,V(a q?.NF/ LVv{k?~8R. 5S}HKy¥%PHAZ^## 1R4⛎ap*jOm 9Ha#W5{eR@{✬_*G (Ȓ4o]J"̺{Dc>O L}wCzű VX,s8͓7ԭWдx4ԯm}]vờ{#0C=ʎun8ɽK*=vcO jen l0O(LtC3_^jɵG<7c!m_9ɾrdžsK.2\XVfa840\Gw}ߧvêmJc55 h8 {MJˆ܀&1Azy/A$o DS6bZ6 or(?}Y#H]e;U}|kQ4oO^81's8H"} ah1ڣb,C?tNSݮOT"wE\{_zO}z U4?;o.N~4~-v,,ѦDHӰs!S'v71u7Ϥiϖ,,C:XDRG8ź/krB//P.ٚZv>tH'Xc),,m5 m8:'GCwjtёXYET}y ?s>}%A[^<@neBC''a(OnQ!En5)EHx"gG/GD0h4r%6G]M*i/P:H>) Ó}/ưГ$D>0Gu5>*BޥJJ~r҄7f,/'qN1 |4]@䴑e9qZwL=z^fqH-Q|^wL#ѯb䴥Kd=q9~O@f9^;y1:Lٮ>Iq<=O*ALY]+͓уAEa:W'AM.lbu}mL\1m2grQVפ _㜚A ZWGvo6m#P䐞oZ :֭,ł;?KesE zƇr:=/k+|)͘ཀ-ٗZ`dusϣ.H]Wm`Δ1.\KaI09/ҊD4K3ܚ5K۞O#ق巐/nR *U*ReUD,rFEK\ȧr'ϗl`k;>*+*ziMIߍqȋVǁTJzB8}c:]^QE(&Psu8[ge}v",z-+90eQCH\rWgHUZ]dRWX9 EG̔nՎ& n]_y Siu1@og i-_x0ۄ {EݒW~(P?(RTTH$ <$ V1s ,ƫ^MA:Q E{ #BZrR&n6iKQ]bz B5ey[?󵸸裀[xo M!'2t X~t,RBgS1 |mHbv5,' zosjh_ўL9̷iuuL&UvHUdJEKoh)FIMv!E8H"MkZ{.#׾(f, ޹z GQ,7F\n1(K(5qB٦Zͤ y4١OEXڹfϽO0m0[:zպV'$`uִ?( FY+pjPR>zqF\:3c%H,("_lڻ٢ J"¾٥~}Pw0C}]~qUa2Եw;Cy̺o|h@1YEVmȟVețc ԂpTNfyAre~̈.7sfmD'+s⼎+%Vz[RxL+:Ow?dm8tWX]QT#8UCRDt ˇIn%A%0fm4s?(vcnp}ijˁpxf>pyF)iB$Puj&PDa&]MMn%-1W}jx{ܪ63yosۺ_5"I3p  ݹq>[=1'Wkˮ,J[#V2wzFƍGpZ2ԗtNsdty$Q:4FO;?Lf~igjBVAɻmZeڽ]Z/S"zh.EA"8K0ЃWxiq󥸦Pok+4Mndь bNH-ڪ6i7Xk)Lrsy:a*?P?cIU6µv{GNb6+TM4Ҵ"H]݋z[:>y ə2÷44H-CCmsG5Ks51 5V/ڼ5 ZO|jXl#,FA?oF>GLOiݒBr kŠOZ B`^LJRɈE)3e:y_bABp-UT6 ta{`ycO篈ޅs\1SowrlvQԉM\B|Lϣ_Kϑu8srqT{9ri]S2}pI[wf-EFg,!uk)t[뱢XeWI<(bo^s/ O=~|7esz~ \Յܱ:H~2)EMǾ{}sΔTNwszq'Ϩ='^RX^QŠMOEbf a(\ W!EK2>5"}a+_ȑv՘EriyVuW.ʓHQx] X48$&xxV T.9a^c\79{B^Oe$+Wm^ZCcNQOOr&~l3~ _ׂOP tfԘsmҩ.ʀ2lTYEĝvKmpzߧꊂ̮r}6u]$%l"i v!Hls.v@Sj܋&PhkCmh$Rk"mrEU.mv! r$tZ=lo;QSt;>Nn*Nb *8;vJ(ylb¶s7u\q/#5Gwssĸ&uKY7%dsKGt0\ 捎.e:PMBv' y%s2$eWQBvܴRYE1" Ymnikf5K;(kM7(LiN?%7CvgrUOwy2r?P>#ժgT"QO1ⳕ7k6/!?HK%{~eW !wc@@&Q ֒"$^ 0A';sݦn_%7ŲG_ ĢPTf2bѝ܃ꫬ>[sSaqi }\'4eendstream endobj 303 0 obj << /Filter /FlateDecode /Length1 1608 /Length2 6857 /Length3 0 /Length 7893 >> stream xڍvT>]҂stH7ҝFl0NiPi[iSP@zџy߳s>Ͻ0m p/PT2yXX Hgȟv# I76E =@APD(*GHA(-@A X&ϟv0(.. A@ @tdp0WH'/ŝxB=;~Jh\  p;'`f An4ڮd?܀y3]\A0o(`u5x^HnfrvP 3Ae9]Fo}`ug2+l..ҝ)BMݽ~7 yl~ʰp3A< j97&m$@_\@TDq@|?xB~ pWݍ ?rCBAHO@  Fl Po?7G@7dy3ap_-30S-/P^BBQQU?ꀠ_!`vp*n`7gЂ 4[ o-Q){8; ?8q3țЄ߬Tc zUCnDfW!P/ vcMxg( ws<@~`7kvWo lտS*p۟' ,! oߜ=xo/ q?{  @`j{);OoX?gqKCDD|..h[3o G 쁸 57@ `)8X2̱&J'ڰ5gbjMwRᭋq8X \Ij&$'فd# Ow |͖&} ;hӘQacLU3[\r1ZE &LM~2筐Oٕ'7H꙽sLA!.-f/3ȥЂ$,ڤ)+Dм h`O&V*:V-;( Qu45bem>l'3B>9E L

MѭMdzIdDd/^gT,P 9E%+k~~͔PUo"XsսFnt +brGHHk>h wu^yľEr3d< ~1k @G*ܾe٧Wljc{?_Wp,Z{$KõRY.94t*+YR['~|' mu4T5 Lr+ @ɯ`?݄.eכstJaY|[k[g`p&Pƙ:T~Z}6aݽY^j/!1tҡ>w[o@}E\00xI׬F[״:b -)gIcpׯ"ƔC?'=J|yEءakMv_E5K[x[fF WݱDiG.Ę<bVۯ`C? שtMvd -b_¦A+Z+2\IZQ=%9l=lɣƛYjs?k%SRqYoi [^Bؓ/'*8ݺǃ\L<8 =`RjR,Q'ľU/Kϛf`5ݮ*?o{)awԄTs~87(۽y.*V?YEQ0epb2ۯc9PK8m71ľ@2ᇼa-\To`;8jkuik  ͙gp>;pT:à P66U$.ӥvQ3ˢ.+oiXPz v FžτF.yok²4: <6 VfύrB1+=6y P}#u‰Ax,4wH{Boc{JSȏa"i/,=7JR-s Ea+uIWK jjOzǹLW m\@IC"ifU-Q~#2T1Hԡf0Bw1* 6ZS;UL8y}z7t_//}y6}vMwtUEYCrjZf!Ю"0B%>Q3G. 1lDdO})TuU+uR:ý^yfghݗMڧwf_#?=CҤGCMA]9{#8.kS }_ =NP[ #z4MfC7G]ɍDjLҔ)r~>%ݓ4)*+GaM_Uj}WMI (Hضf4jfLUT4 nҐ[%xm6r?3n>7jjժSJ*eOfЛKmRzk^q EbB2LXb{aM| Ͷ-̳#erI>EYzYlLv~CL4e_vꗉ9wҾ=M;˻OiV_C5]#rs߹,Ynk,;[)ݝx3|lzCuRdSP+0Dqɉ=8}]f@]mTĽH}2=[du))x[BhooR9=X ?jQ~lǢC4\!$qFeN#ϒ.BG:r[ÓןOf2`{ X.Y v -gNAY;er.]Y^$!u[n/5jฑ=N$UZz{wenw6( ěUW-S+OqذNÖ+Gr`Awnn}ʡ(Ƕrtc)74͆Sr!{;3_"d9pԯ3'$zg[8њ-w 0%߯ҌCLIpde?3ܶ`!km+0j"b%{IQ!U)1(c</$GAi^𷎏bxa0oJmګW2%Em>r V"Q:Ҩb6V{U-fZcD^FCѯ!zRRn ?%fyoc +>!]ְil9 ^ayYN?Ī($<ӺkxMlNb2I|ɣ3ش 1 0cp_Au&mIzRP踎kwP5?>\NY}1|!9S^vt"[,slt#-# vJe&0ڈ ׎%iOv \/2w?Ł%~̆]0(+Ia |3Qq[8fm'dGqD9;|%QE1a,f^E BtYPVqr`V vbM{R1ׯKF ^]?qS{2.|FiC7MSFCGP.Ntwr]=]OL".;| fJIDaU3cPlcu'Zh@1/YWnfX+Յ[HcM֪%brnpx#Gl] B)8 >15ET3gakڒu%R pR-i <" ̚`zGK_x}<[@s[jq# <r6[Ƒ]o}U3HZ&G:y\OFv}&@**tv)+Š{AOb_ oSm։#K׮D]Nf @K,W^K8?ȌlNlBFZP@ |,?uU ԆfS~(Wn4ܒ>,[aŏMmC- m ucL5WXyuoXB6),!Dp)uȺ(&-45ϾL'ƉxYGyK5D%ݛU#^}ÃHr*eꓟˍ c?!?~[]y(γVJtZ:3(*Ԣq%m)R/Jb2 ;ӴܤWugpm$KzBs~ "QjPkVʚ;{R~ } +tT2g% zL׺GףJߊF9׎+u^ky8e(TgzHl;*H[lɵy&Sco#s͛ٚlߌS{5,1۱y t)A.o]D"Pyڵ2/z Ed>1ߚj*[+~!/r mct^RTR(~8sX[nuSv3#&)R4'htLHٯ2l1ET{|aZ{{JyOl}{|Qi~u m!cQJ%>9+SaUW S#!`!7-{xA6]:W/~8Z:97à 9 pJ_yk>e}4qwKBy"D2e +{sI얚[ZIL]iuYYXv|I{x, 3e(KwP5Lk6lA.!ьVwR]mnֹ'2'~ j 0~.2T\*ȹ"5 r,ύjΥ#%vMb60jS|s]<\{fF{u,xԢ3٦J'Xa9u8Hj.a~Z*MSS8k%,I%M=3^D)ofaIFD~pNrJxs '8V2tf8ڄyRFG*dcHIE4GA_61zFY,Ro'bsJˌ|6&h@6%3MV$v@V11vLڣU4# dEd;+#:<iD[ߢ=(o:WrLh!۶D)~a7 a!*Jcz5%O6VD7G"5*1OI- Y`d_`_ox7T;/J;JY?8\X!kvJ4Xuحz7i?XSTsL~ AL;Gup.X* Tø&$TfNOQuh$ϣiwϽy@%y/WF8TT֞zYL潗.Żѭ=,[:2"ش18H?pO|xuN(i^|> N]N(Tm8Ojo*ڸqX97h=ig|I6=1Ff!OQoVY#m|] RRP՜ :*S 7h3籮KK⦞bPr{LF2>s+:~IqD}/Ab=JS.Y,)γw}s^zendstream endobj 304 0 obj << /Filter /FlateDecode /Length1 1761 /Length2 11447 /Length3 0 /Length 12579 >> stream xڍP-Lpw@nw A%X`]9ܛ{WWS|{uW)TԙD ) ( `e`feeGְ؁eG99[!B^l@ Q``qYYvH]9ZdmiyG;ƿ 'k3@ٿT4f @XX\]]`'K!:F5 r9[(AƌL аvۡ@%䃃9 R.Pv9MVؘ߉  k;@YJavx hB@*?99Y;B~;kt0ۃ ȿ'a2{y, /da`n ,?d%Ἐ,A+//r3b]@oOG#  @>= `nm,d1,/wv賾ȏ '1&?-)&vx2qعXl79du~W'.Hw %A?7`b5{wDRMv0^q_6V[_,$/Bgbdfn,e2WY-M㥆Hlybeپ\./3t~YD_A/t0Iv.n "d{Y^s_0;!/!`'߃6,bE}+EbA/9 F/L?0Kuw/>37z`y_jZ_F/ۋ,Y8| q㋄x9tlg;KF 샓Dڴi u@n 3yMmPM(+q;x"_rx#^=3cYTjMȦKIM¹Vy;Ԯ%iիkyf\d12b~(Hn$as~uj 4%R8<'_%`*%?D"P=!4ȁy]Mҙف!mb7IEۡ-)w\ToY0MB Zi2_V+~ʅ˻/N?|O՟eT|*:nvn}[%ɀAm7@e6xV]7ժ]CV?,4JMtWOy睝b4"<{}*Ƚ;fcZoV%jqUa0h.h1  MNYm/쒬:D)lŁRuwx XWǯ5e=׏-|*Ԛ'i/:8B;ɐߺk#b▲77ڏhC{1Q-ّt35ijPK}qpaILt!NiLl 6;#*XAh<Ӧ$E՘ex֓rV J,>6g?kqRj,MhbANPCP =>S*xڋL ~yK\|w.oc3xL!DUa{^ά roE޵c &-ZNl>P6]R_Sbd ~m T%~19Cq.KjTc>ǯ pnawEwG kB8[9C#5O3|ȡd頖cd3]R|_A9eVJu;n읩D^Xu$6IFݨ1B,9Uk۬޹^@0r(:^uEQ9Ij[DIAd0Sf{;B_4S$8_G 8Sij2T82t0˸~6f˟q|&QgfDD9_s Tx2i!9֌>:E&,ǿ}MP[ْi9y' Zfq(OFhQez,HF 3-m4P&IKq][o|3kP`#f%Xıܭ1/Ӿ_4a]~G W]Q9wT, ak[1i3 %{?EjLv>k ”DWjqoD0$ƺDS#}H' 2,v%hFrj3Y.ֻi\R3Lc%n`GGvS%4UX)4KDOf1K4q8nVCg$O 5kŴ{'bLXm-Yɶmd+"owZg@H0ю>#''(:DyE=.fw*SnOŗt:_5K%(MfW[#qcv]lu@ҫ{~,&6Xw{?Ǚڼm}D~*6"-gTfOg[bk:w#lM9.@:^MզI4F*q ڷ;gE{?3[6p Î/b_~q$x^GTXo_>WM\7Z_; NVVeX̉|oцr = !Ǥ]2T"\@Ľk_15Tc21.HrQb%OA0bkuV=1Cڪ%#Nn,6eTZjfW/0^Il)."l H1TbxtU%a"NiXڪjz`O*;w{[RLZ;5@ƚ?*#'R՚|nTWȗMK*#T]V]寺^\ c:mPp6q6͊Zzun5NpngNڔ PRbwje mb H[𩉊vlHsq8ʲgK',h#3M;\%|2v]f[OP* oL,D,q!I mY=98A1c0X_OfPsQg&EX Hnْ@yˏ{V| Km_-h)~W"|{mlOLBU8 |[3ǖۯ|b.N雸.0.)A#~%>OHP"l[nZQF+0Z(ru7\7I8yPR33;KLR,:|z[``qXa@#H6W: aPش~}x-j0/HÉBuTfs:i*AGO?aBIՌţClgW39IJnQoV~UΦ qjQCMq\ %; \*cOusսD :ᦻ%[vg\ҼƵ{z1%ه'l搕M9Fb9ո+NS&gv+h WҔ@ę򻉬uӎlק(FѩgxX&*>+’;4u NTHT Q,nP?t5s5C8>_T$h cQIn$ lMETG'Bv4ߔmDe%9JugfMKa$d ^ |MԡSs;^ߋsCb^*y*!C:mӂ/W|_`]~I_@9{2묬i i Bũ뱈Xt}0~ˮgAَS5$ 7+"9w^r(t2ތ.t~#džGIm'?V'zࠚ>iP*^mGB}dQ$nz-hM4 A&ۅ0MnyM@/+׃Gɑ&*rkLd(5%5Z}i4TB(T kp~2mL$Rr6t[mak?\2bNs#CJմQQ\ w# FA7㨞2M\nePM^`᠟pmPq$/%쵋ěF\dM1*z@/s\#%ǐ͎H/3,`J%(>=Ō_Kƫos\):w2kmy߻M m^0e>HOzWy^TM0YCkͯі+|JԶi\MJ[#wXF=:_W v(IO>@R/ɽEj*t8lLd6ե^Xf=x2`#ѷ%ՋL6^+g :X(gBA{$[,f-k_f_74M@]^rFf+rPlx٦ЂXV:Q/{HX/o4ζ_1 ҏ!MsYz2s}1QUɿ39:ظGp͙ETgTV#E䒦7SR,A[{m5a^^K[_ٽ=RXw#U[°a= u;Iٖc{YqУW2Ɏ-;ZfVYv4rzWZ`*Q@+Ă Fl+%< R+ |1Ǧ g=f7q=ltDTm'au"r1XgzL(+iID̴ .}'$ĀM<2!Tcr'K-[!>IHykNl {OɆ:>D7W(C&W]ZIyFun;qLιDO{vFGWC3у^> DeHplWsћ16Cy~˽4[ ,DoW-kПC8|vJ"U*"Gn=~ehhOSަx_[Rr1hj!?olK͊: kB`PUؑ<=bo%XS! Yƺ8o'صC ˓Wb8UK7!C9 CMM8@@UnG>7/Ԑ EBi1ap8(/3 5a+ y9 $Ek&gi;[H"Scb N:8PDqʨ,OU6 a Vf ɲF_hJ/-3#w(!%ɆNNߖkbDbtzҤ$ٖxdxȮ D+x0DZXFs mnze#}^f DѠA'Su\*Zs2Y$y~xB251k)=t7z=?Ss2Fl+M;:LPQY ,5b>6ܑe!)`QЀ4Ek ?x@%y..-:l>0 9AgCCѹC55ůLJtikT{OލBr7x hG^6N[$##+ׯJ i1}+>;lp_?bgՈ.3  30 O2_2եJp๙,ncHK4_G֛/A\𝾁\Mgn>N\ԓ6nIiUZmB.o CX-pJhS4tœ1uu/LL[W.r$tseX.Y V 8X 6qnL ,Bَv*nv Nr32[0qf0f[]TrBGBKJah1iPj+x%ǭPMZ^pFUlR$ fG}Ӳw=1y- \+$DoGF'n7{17nE^;uʮ0Zm~hNտ][*f ƂbX9^z(I!MCGPL+B3j޼i6\ kb (>u $)TS /&f.K , і98NhND8W}fݬY9SwIĒ5m3Ueʬ_̇ow>E<7jXЬqo#2CpQ͖Sl?vB$GAq?QZ* +&Yժ.ZR#0eˣ2Q$T% wݬVSFjxFѠQ1OVن3j/R٥R}һ9-_"jQNAIݦDjlpx<LL7 b62=dR!j2?Gkag<6m+Sو8QKk{c FX"CAfVSm "B!vgFQsp/f#[}+FsagIuh0Î,%ڪ8(ϰdx@ѵ=SKĢ{5 T$xjՙ{% *NVLioE0}V(}Qw3 0_4{L<ת{xŃEE}৬-S%̾km+w#ĜfOmRQzκ7 ;9\pȺS3Hx*1I!s}Ŵq_(3W.𘹞q9eW6EV3-5u GOZi(Xij$gj.pbFLlT% h>CΖ'M r[x[ I^qӓ9r?=MTW<.<n_&-͍ UȕG"(_2otr& b+.qCG:m.a\$qrCNSCsB|MNf ,*5J4Z`4FQ$0oЭkmO#^I໺(ӟb2Vnoks(0<e7)Blܒ M3h%[ߩaQv%m:BYRxN^w>Ȅ% &켄_$x{GL^2FTu2=X*RuDqkd8P8\IW_Ʊm 4R&,oҹĝI 2˨mBW]!O f^Mv{m&l5f'twGrFy<m[1ʷv%PTbHģzDrn.=.o) {^'XMΉu0>6YHIX7K}()Ō\rt!lIRݨPNnj~E$FRG(:  Bʶ_D>/gt+tqΐ5+Jߏؙ4 \9eU4l&\䨃3CB-@HՆdyhX{ D3/jt,MKaOm9 %m/׵8th(qң}G*qY*wikyu64IlqY5MJ˕]12탰W*sS{hq$vm+i`8|tXYaEdxx39,E 7.FYMz*:׏8 lp$UV! ;{ 2 tK!3ڔPY4ˡbNFͲDlҋ 9yQsgL{6QӚTC{iɶ Ϭ,cI>'3Q采a1Ƥ,)\ 3/ϑBUXj ɼvpNNkV4hp7[Vӏ+]O/ORp򢘎'm$m1-tmqױ*Kv=Zi8rQPR*ިd{PipI (2.k7OE\R/gq*&jwgeCز5w>| 9`O>"ZJTr8֓*gaC6 hiof~E*pABN]96YGH{g\+iW8α Ûr6i(B0rrj:1j4Rv#A^OiޒB (^B81&,:;&Cz]wUD>yddp24^Hu{/=j+yr@lU9z;6#ۓpZ)Lo;Y{\$kpcۥ4ͥK1Xe)sY6=5AtRh3.2 bPNfQ>g}mg{6&i}iSN9Ne?=W_T̎B/jg_ LJ^ CͯrEPx~g:2bU0^Eϗs;zIU]uE۲YQ T *^)1bBt?~x(k{[@;(9uc7:/Kg!86[3;iŶ7ΰ&gUbg5gҚoYr]X8LwKʹ_{˛4ϗ mzhN\h1rP vԖE 0MF\H}^3^WbmG)1gƐ+& +d߫gi{2ۢ e'̺ƴu3wWCTsw6gYΜA?Rk[ݴ6~eUPhaWm0%!zCFe s;hE6bMޢ8lo^-&qd no ̴&'Xijsx$52YC8&|lćrcځ68FaDfU澆d$ކF[ [`e4^nWx>U\ʁr 2_4&k=Ӌn/RX# )奇<]0F=& Qvur?'5\ X( iF.[ Ux춆NB# bLkZ})}p6}}ÉJҹؘ*ςTW5ߢ9ë.9W+VJ+lŭ&#oCjqMcOdՈ i !O Y꽞MO]f,HRM׳![Tf *i7uendstream endobj 305 0 obj << /Filter /FlateDecode /Length1 1555 /Length2 8365 /Length3 0 /Length 9398 >> stream xڍT_5L4C7 )0C !% H7H ")/?wZԽ}.#DqEjjJ ddԅ!1!nPgȺA,69KC3 @" A  &ZԸ0;&K vA0%# B>UEwtrrv`xAvm;b EnÌ kucq{YAG(sYCtT.؟`?S_ɖ`% @! U.7` hoi uz}rK_nP;;E_enYf-1O?\:`~( kn=$Wȃ _- 7؎Wy]o'A $jysnt7P0`0`wz~Le s7wt 0'# 8yH|XwUـT8@?.oɂ寑aZX ~wUIq[:A} xa,Ԝ?z8W n00s|Pw7Z ߽x h:C8Y@?taΊ C!;[F~ ?0zps)g7_m~ ?H/p ~adpC>d|Hw(vq{=\o>\3xCs`0ưzi /I1ԣKCb3 ZNnΒJ H̾G]2k& No4Vs~?(Z dE܆4b>agnXHb"*WTT/Q%_׆Yn1;%<kE"}U U_Lg1 8zJM~^SBEV!=1-W{79ҟš\r,޽<|p|Ns?F֙P{,G_| sS\@"Yi|xi07ߵQ # 1ZW &*N{vkM*F%s|Q"xZv3RHMmX<[XX5WU繵i(y!Ai@O4{l?j^DZ8tƂh[EsdNDByq?ҵSb*k6]tͪ~y^ =1p$>x[*6i Nj{1qFU|3.a0HO,$փ`uV͗> 7&;6#5UZao Ydb[Â+M27ɵ_|=nӥ^tRj\c ٙp݈`"-7LHw[S7X |Do6\ EYMw1Z*l#0ѡ|CRY;h{v̵$XMŘdc]O:|.o$}/;.sgpc* جQ`5k[dr/T]{nwd0L{. ND:xe̊Du:֋YH#Q 44d]S қ_B?G ~mipݔ*\cƗGU~5 ͘ π6w}/uUe`kuo#o! /j PqQjT eК#re*^M4<^gܷVޟ|H%V5޴FZt#6i]=# @j Te[Aqsd̋R˄j>}7' ū,SkRO%^JY&8hVH>k$ݗ]*'-ʭ0$`)rp8%W[RY;${DLoʔJL> pܼe춾b)~4E`ЉF}Q]Ul`V$O: &=Q,KQKˍx+RIz7|;V"c3M^-ODf2x_,m^?8:~]A2gt|o\=?1Qϋ PYKQ2/-3rBCEJλ}{Rb+0&*߷!9kt$To ]w~1 TǭדPQ(b%Ԏc1Bx?X /.=H};ƶwı<9x`b5}kiVY4#p3}X.# ZSʅye{|"M5p_$3PK0| ?a/r`$m|4BrH,pZ29Gq[:tA0i=t>b=nc3牍1%٦Eiuc?V d3;Y P2M`זּץG=\}޵u,1D/u4rkJi( UCOxmu^jou ԝU G𸔸/YrNIU%.ܚeՙ# 24L%ω"koRLZ4u Lq> /&@ĎX>R;s>Ao \$N_oNi~\c܃8wѪ,.J&8k> X@\Ȧ^ZJH#'#?|54(yMܮwծ$4=s%՛QGK( 3(9};(Ail5Q-?ςᰐDЎ6M) UCak4 NwM/-vPLfbtѮ+4}δiiY \)caEx]IjZlȕ=LE@M`0M,(ϗٔ,,fḣCO)sJ1Vh9.79j>Oiis\EqEUcՇ ͶIv48$!ՄM7* S4Z BǑY82dsmZT<o>g0no# \䥸j0Rp.7uqnjƉJe<]@(P=%R_cƨXt{x*#ZLz##$hmE}S_NC}T3|SηcUlk՗r;JHPɈQJT.w{D#q5t=hcm#5#ye)i)Mdz⎑B%]k7z*O8c"(ǎel[X4<~fۇC՗?ޏ(EN:C\a29ɻGd$['b_6|*cXYP]*7BvoW5QN0n9qWQ*AvkJV,SÑ`IkL.vE,7f4"~2=z?љ 6W/f- +^q ronj_{l_C?^n_55%Qalo4 |l\;6u(ӚV &l>nC5:Hī I1DR|: HtQC$w hVY8zO'~($KznϵEΓYߤu4e~d?QB͏\|/'0;%>ḿ};->_^E KbVnsºmIؕc3dΓke= >f^YY2dd+qcMo)4شg7}K8J ؜gPt}bm>o20,g>C_v8Uk  Ŋ'#ԉdؙ-xÌĪ1]J_܋zpr0NG%qrf h襭.9|V1+~LKh7ag: Bn8UM _8Mt%Pf_l+!?+fq|V^RY/!S@!Ncn)Qz9(cU"RZ,X^T`Qf }[Jbt9DjB^}M1YX2.:TUii7I* ӉEܘϵ%&PӜbٞGrAbQ&@Dž(:+k}&9##+q$gp0hqh,J+:Ƒ Gltdj286nJ)>hIۜk}';T>*[m"pǥB*O@`۪J&}øs zz( ȱ-o$ 2VabiaR#l€EtLT4ͷɼ!cC:$kΉљ!q))d,$GLEF3Uٹj׸vc6e{OOy WjəeJ =%RCӽ;ÄgxѾpT? 2$Ӳڙj(u18uuunzV8bT̺gljߕ ^{ TkxFok%{>g7HV3UEdSW?#PO^\V%Jּ*¦GJkI~?dXӗ7]9$5 D ?b; !jfUșr7PCɆDLT>:=IByyN^jr8JLw*ciiyFXai"ǽnc\VУ܃p*];wyο̄&gK4IAM`-zښ7%s n'CDkfH]VI~ Uࣗ-gn;5}zwP櫣vʼn7':Bi L Z V7ZSװQ`ira.FQy_6^ūg[rfy+7jd0YT+QO$i*ܻfTR4=|Yc_xyi'48/bXGD†T<ǨW$vϨ.YN$Wn(5SJ_ڑ!q"Q+92M7p<<`<."-5hK ΦvK%Щ? l9[ 8HmUDbWqi֑B f $!q%Y׾~ {D^/@!8xJF5L[UGzTk_\Ypz0ϸCo1kkNߚ==w\Y?< ;)ɘR+(bCx)bJt+\䑼;PǕU T B8JW Mʕ,S6dʚ7 _o`"|DJi˵Qx{m){U~Kl9~km^6MMpeτАgcEr۸#i r'58ycӟte{9\4k谟 \tuuU^A,mڛcw5ɎY20t8(Ǯ`2׃4atϕJUnb \Yav:^]+)=<R;.NV{2Ô#(cBH'KB~՜f#)8Q^Guj^X=Blxd{OdRPn4_W:NMd9 5`К*R| iXY&6hE HiM,Fw)ͽص3Y$ڐVJ- 'NQF}?Yb$u,}SBùW9$8D,w2/<2mI֖Jj.%0r=]R`jkCm8/*$&{mݭbl%:#h}XhzPQGQo_upFQoQ/ =G<dR\y3#0g4 O/Rz1Vr߳gkZ^Q9Miu:d`6̸m?L^Z>ۄ yOE/p2o 9=%goOˠez"VxVt >8X\ScjQv9 gXI6Hb6ҩCΜe!䚞 wCoݷUs_%/;q7e*}r XQs5QyL|1A0#}I ,]J=J C z=?>eAKXL#^obj?nFI0di/~|4qS%II!51`w{+J~Nzsڣbub'Qzcֵ:1g`4IMC: x=ߟ.7ud,/IhoU-JsQYO}XX"u sĀSRq ͌ƕu<{kxFucZEJmz~iu2&V†^(>'55~"EφC4M鹋V V0 ^(Kn;q 8EPe cLk>y&sA'r)Fr6ӼC˅Y]R\G#Xl#endstream endobj 306 0 obj << /Filter /FlateDecode /Length1 2827 /Length2 24896 /Length3 0 /Length 26476 >> stream xڌTU  ]RM)C鐐n;$;x7ƽ1`=zׂTYA(re`ad)0Y)(ԭ])4. ?Ĝ&`+XOuX8yYx.&@σ"D+hi B|-;[{`x@v^/IYNTT]=u03X9, _7%U6e@sy3  P>36_[ye7WZ(8UʸCdio]$=֮fVvog *;Xl 3™ق/p:!%@f`ln=q|XjkL W wG99L"E#N 0 n 0IL/$XL/ $L/Eȿ 0\E`./E 0\4^ szA`./E_v&"x=;oL\_L_8=Sg3[ fۿpTؙx'ag-'x*^谰0:]K&Qd'. +xzM\^2m7Y@7~ֿ_9~CV,/ܜV㽰eGr N\?SwTU~6/Gٛy-`D/>b]Ǘcp GG?N</g폶.KC#7_ٿ[ 47O\6fbG~ hoyti`'.7IKb\S ~i1Z9op]=0p;3cJ֞@{? \/o n_f^zBlB:nkD<)Ri|;_} Zs8܃)A}%Dsޖ(Aurqag[H}?!f-t+Y\'7}Reˣas*;՜rHeS 1f(Lfº2bz\]Oc|{&MC;e+]g}7Z҅OG}1:I#,;SR2_DB€ƸǚQm ju]̲BE0T[ڌeV (ӵHBtZ&pg0cuiuMXJpn?OBB,VzQ+˼D)0ecP]Z@,4%0&>AgoX~23rBsl>oa̩l%ߊM83:/C;2{ _q&tQԋD> yT|p~OfF{[Jש,f0֍]Co 7k͆UVگR0/%%1Y\fuR(KkШ3s`edUt!Q-hÀ$aGCBp.8$wRoiB<:( aMh=&txm)=svޘf +1eAH|hb"&K4CUP}\Ճxn#aWvWGV jAS4NKoW&Պв5>}IO'8-8E풱eY{&- vJoIr91yT7d{#l>鍯1mT35[BL[5Q@7hZ6X†ɷ11JQ){ݚ|87,2G@_`]zԄϚ,L*cWI[fgG7LUXpkFy~8i|-$廘N膇,-#7x~ZU_(9ZA\F2Id`d.'x/}v:5i1D>o6HD/s\,"neYȎ" XM=>Й\K oGVߦ*r/!h!Q5AcҚ,xq@M,l׌9ybxFwB{aѡz-z9%}nCE^>!Sq }2;O(YDa i %΢<ؠJ1>2san [hi3Iv԰H 1QŐ|EO= +h;>nc`At7JšIj[wQ`$K9(wD'/|;q3sIeYIr輤uǫpejC30E0r!j(%+F7 fjs[̯cZL^e1*U>HҖX*͍  (T2t1t~ E7 :㒐O1r]1Tu*2[ə]z%4\}rAYȵ:T3&=MgT3kiL #GhY<$xdaĺܑtFE"9ƵSC =p M 5 [}"0ȯ']c:ۋ<|8AӦ |u:u2IC'#5gm:tGvZ!w>O^hgKq`6}%g\k^J}UF@}"ION8n{} Rg}١ҺqG ](ޛx#^?Zօ:doqBn7祅W-?ڶ2d\=S 3bPm.y=q%#\͉W76UKqIe6.BueAzZqYR 0%.KcQfcENt_i |pg`8*%wQ[1xjKDB$hMڭ"gusp CmH7.vɜNz$⊎|POEͤp7OnjxJdx94!&@ޱ>7 Z;, jۯuD .m>DunEǯт-G$ CO %=ǫ_]ʄG "iUn(Z-w|!vBO1n i^-ePPCBڬ=%cN@Tw7E\4iҠlJ>aL w.lyd/- J3'<{EX-q)miD[Ze5]K:{0'6(DS"{t;_Z109ިG-Uɧ<:ʀFu}x{/k)%?GO]!TnRj*N;DU ,hCïee!?NRe y'a Q-1E?ZhqMc|I=ӠCINwA]4g4ݼ I>4zE*L(ZEns陱 .!u#]g$85UZ vu9NvVIfeƅzu(C5IP#=Rbe R* ѻgcJiIg8WQgwl0Fo4vb`x0 >IZʵﰦ/abZf?F> 'lKgn[УWk%_i$#Q42=hN-1FfxmȊZW#2;\PZ堥6VLCotϽ]|C g0x,f;>͝! '՛7/$=fW.<ܡŽ~au~®ꚬzu#D8oQ{||&bCJHw~nm^WAKBftG+j#=p݀Ϙ7&+wG>3@&8/QwyUPi3Pi}Xvv=X"R>PLoQ{~{:G tk;_(ṖƔ(`6;%[Jh*cɫf=Ϊ1=a8*H4S!$|d"j'j~zLldf%s%蝴%llwv9tdO@|Fg1*-Imt"YOuNMuΪ'A˖@dbY2ƨR/Z1TVl<+g[d΍( [54.!mO#\H_SSI.U}@6];9^;) ~ }/V-Wb [uN t5g&Ջ>PP`hL+y+ENңF ~1aޭMBfai3AP4{pV(`6M#|RSkʕYf_u34c2J_#+YAFfuc`W jO\)2ԾRrS~l1>sޕ߄\I%W0~^z30+k,^*nDOj{ڭ`yƍ^@0Ԍzxև9r<\C{K^)S -\TxN =Gvۘ KoՄ/A5vbU^YR FH3Ju^"oӾw95!T8G2f͆&m%6u҂r~:'U۩ P]+%V4~ݬOfITG۝+di6L͍ \t%Z@RzܸU+Q#vځ03At0<w@[Uuzj/F8͝Ň_o6U2}WNG yk~6%9O-#ulVi2a?ޡPS­JݢJU*5TNj5GhAr.y#)C< *?VFia\Ֆ7[=sy՜om۶"h#SokSz4k%7a: |PB+ԜjQE~ӝzw6 w!Kٵ\ Ҋb=F1+8?s8 [}حTfHL$N7wJL}/D`Úla D{ּks,wd\J⏴m,s<_D7*#@9cOd)jm ? ښdȅ C>ik"牧Bi<دa O#6ag5EmlݪeLĸW] ) .luOy?:4XZH=΍m^M:a{4ZVU3ݓ Ÿ.aZ*qG2<7;(wV&26dPa2+ ҹEX2Iӫ-9ȗQ22L%AޟK;[ǣ/ƙA3fQ!Fس6'qtb~Dpxc=']}ʙձ?'WX`-Zp6|gpc=] MhŰ¼(_J`h1pJ/31g$ l̘8y{MZ>Um-4'hԉ(Jv&S:tY.i?qϴ_„/5+ѕeZwYX C}OIR`adL aa_kʱ*.Sr[ݡO]^I"TuK BΆiLWxbc@%Ij8H$FERblw@^HKYU  ^25Z*c#wVPsH,Ũv ;44tӎ|Z: ׎MsKOߊ6>"&ٴ3E.3 ꫲ`=6=Q~wG7dz&u Ka Nz*TM/͐v^t]$${67/bNL]-k0qЇ-vm,J7UwʌBN4ZLEaB;WƜӲT \sW @aɑ0Ri)7NW+'Y=;Ñ*_WDޠãݘfe@RBi&h_[K'$R"'UZP?" E4hB\^$ MChE_7l?QHEG$&"u|zH YA,d+DR/r[w3?zl_49~"hЧFf?)lhTMA;/ >u"*%-+AgL#aD@9&(Og8qcJXW*#}8ܑ^2{"lw t3\4ye^=kU3|x>w=: ftJaJ'脵!ҵ BLQ8N m:j#eUk̈`+/E{vwy^)597eTg#KqlnzT]S U6l~Qp" 8#ŽBg%v"'il#= 5ĢpJ?lsVE fVyYNoD3/lټ"d[B_fdv]3ü}!JG}QT!lC s޾ׄ@W2;Dݦc?kY/*5=nkhs/8jkSxג1JL\ߕNs|-sV=䖼Dc ?N?ߩƎ4p;< EqMy=LWQ)d ZtQKC.Ϣ&@M-? 0zH rRAh' r /ٵV~%oqi"SF9,39(?DxK{{u*sG_ry"6ku'ɐ D|ɼ?GeGX">3 o6´pREJ&f]E}]s`<0y=Zk0S 㓽S8IxKP%V 4hsJ/>곳Jy4B٬BS_׀*2+9 @$ijM~ws.Ml%tawtf9lUh0 1Ohن |xf_AIUƓv뛳Ɏϩ_Pp/Ȋ]. GZ_5ф`G8f[.'Q --*H DB?(I_FME{fS|At0w)vbޮ5[brys4F \ڈN/{dsҫǵ=ƅd"sw'#RV٫ OvhnwC~\wFY/]Vs~$ R=8lWi~@@_2S**6"W]N1XwB4K`T!?p]~Pq/%W Wٞe0Ƅp5/cys" Jxݕ[Xײ@yӦY}C;uEvƫմ!v,M_f@Bax[' `';3O˺;kՙ7 N깈E7Er`ih  "uNOYI1@|s3Koʬcq0iRVTLbɣ1`QiqhI7A 9;=%qimcTo\qq: ÷pFm(Fs "`CBNz_c ;ɚ]r bJЍH dƩ7Afo~]H{^u\(k`_v??UJ hP36XikT91Xqza>}t$E)_'pҏ5/΅ rS֥`W˙j\goYapJƨQ9)1Z_zHh0Eg1& 2‡!$Й CR@Om*/AXss1ӳWǠ5Ajn.')~ۃ;JXWݳ ')^EZ*Bԝ6\@ۊ#iT]K8@Jo-I'FXOx]~%@tĆEg) ip#lhXNFъ4Z W/jLA#ȓG(4W\a6_h5?8 PQ( # 5~ [~iF؏~҆7gCjAXKl!%V`zrݢqP&%Nau l—m+T>ԩdUd?/K\\pz[]J m BT'|?CErx_g!+B8{[?VI*v|`@{K+96<gjxҟ^4;]#G&xaW"j $:=PunoB*:w]@!?=\ߚ>n} #I)ͪF5^?t t1K7dOZLk 0XJ95,A k)BT6Vk%rj+rugKZBqzS;5qH/h#}HqPu@]cPvJ_6)YQ7nX?Oh ZlVV*"S]HwL&Y\@d`@ҷА(h|d-$X@tr^}󄠹*R+k5=oe,3f7*Umnp$ʎӾ5ՓJrw 'Ϳ iSd9R3<6[/\HҢ#oS/Sc/cMTh0mTfN94lm][8ŏPQS0ŘE8IO?(S/0^T:+(=csq{j6E Aˤ92Lȧފu)薊9,lxmOGfug>ß*J1~v|[GVK a 푏δ_AuG<G%ߧﹴ?+cENбu/®,B*V߆aX0kS{dY .ƃ\ k-epY_e6P|j~5wyv{Ƞl/UP .YAbKFLg7~ f&Zr#bGל3Ps,阘ϒedn(bE-kzEəYwU1#]qD$PlxԣhڮWdQ0%wzͻ٠ȱ`F<-,~$ Hyjn.^F%TB!xdҔz3xq^MDo%ڌDt|Mӊ= ZPV⼍f%ϝ›}"h4xPcG@e&#ޕ+[ioDhmj=1q!Y"*T}?ƒb>/UU^FR:a]LI]md_\+EA5sxJdG$0 _E߶-l%^NG-gv^U0 G:H/>¨?![Ҋ:P UZ$kk:5e6E-sWv*+p:3p5t GX*ږGWb0P:nqHs geMn_"J #X 6g UoP~/4ȸmN5]ݿ$VL7p#E13j[h֙cALژ.mR6#nx׫:fyeB'bxUln2?)\-z0uD! d?k!,j5!LQCa|G4 ǘN-tzFBrD͌ F]h =:ʬFP^9͑Ѻ ZҔBcd&avA ٔ3tGA9\ <9I=r e()ۘ|wrYa|T.)ɺ½A%U):DS4,QKmk;1 {e  jrrQ-~cq5O\ylgá.Ưe!^@M$k7Cdk(űI8ғn;wq.C >O'VaRsn*vlR B-tXM/ =27@nZAB~&`G!6s',d!8WXܬ+^3ܞXGS2iVmׁ:|̡}xWfFЕ!Hraˀq3ob{Xʕ60y' _0[LsW[hÈ@c,'OD bsd::OJc `C y[Mp {}^\^qӅ;HR!?LuQ,r$1KjY۬w#V l% [ID$ÌLlo;Q7!X̋R3ILq/AzT!Lq~޼R_Mr(̱͞x݁aN./6rrS\GOM qQփJDZRXWuKY R+|ȎΉQ mU9_BՒ8 TI۲Z _[ag9]'Kݒ zʀfakcYF $! ѧ5 ._k٧%YЭzIkA:\ovM݆L|/ L=zd*c†[cNL^qKP=u u]D$ .Fd@,C_d'= -HR}HTvH SfU|8(]Cz54d7wK Wlu4I/Qmu3=U}'Z7ަ;^iKta]m$N6P@9Zv$bhk˸jRj\RŌiM_xІ#r&э9*Jl=-lPƹ?,? \G`5\8rͬHo}/G2`O00fReIDP (+ɼ%wVڅUNYK+Qq/Si|$uF'dE_GEVhb hTz##@,}JAEOH]`φBضS;B '+E6G$dk퀀ԊpiBf_b0Q;\"WѮ@lصq NDsIY'Y+wodd4R{Ф te[p9F;? WY?gJMs.qFx"30L]|th?7m| N!?+0E5 E±nY E]KmɘPub6C:)!F%i&vRXC޸`˓Ia \W}Yմͳj^󅁣CiiU^{jpYxS%In?aP\P J ʈN 8mI#"wC-hBg hLѱkZH3! `c+bMwOEi^m1`9l9+.U~}ݡ=g7 \P6`ORBg/f@1w"yhΛG) K=b3Xd{PvCr{>ٹu( It.|/s3CYm=5ي:ϷF¦Gf%7Iud 7G\K) ;d3~ޭN-ܚ܏ 1HtۉFjMI)..IՒs\'d!NmHUbө pZ'8J~?oCOkxlp2V  7Ɠhtnp%)ZÀ+3wK&,b|*B֤us%Cm{!dmcuf[iD?5Q= 3EYH=}yK?)1Xϴk|N)8eyZ&g @ #s?qJ6+;h֭C%5)` )Cu)u-L[+B=={&LL Nhpf@1ς$8aaի68:m>/UNXPt7YR`O0#Lb56ӡ{ڱAwmq]Ð$Ӥ|6ӦľyhSa#؍L Lдg[8/iA%p(sTÝ$"*9C.#.9`J>Bl?; ]7ߏe7"-o|؟T~z(PI䇳RE e_5." ~&ȏ'4P@5 ,@ߒ"Votߍ:N SP&r LkF#ƌ-.cZs'wT `wpcTI~N[n_[2mEb1tNLG0 -y/C^a`Q"jER( \;PIa!J5c~#9uGދ{_Yx<|[D \us/M/ѩL$]boK%.VHW{ m(<x(UpOW4sr%xhk8_4J*?BՔckUn>"h8NIF4R"lQ;^!jZ]n ]g%PɥAw&ǂa>kJi#1(Y|H=L[`t,X qp {/·Kz9Xϻf˔o^HͻoE&.bD `DRnpy"~][Jegk֕m 6ᑪv\1[8>Z9&0uQllrhk ~C+c[I6ۘa>gI"My{ X?[j Ю7\Ў+=DTqk̜C%C K31o69yTj]F S1zh|6p$Z{^B㕨rF5T>SŊM$t.9IJb9u#*7y& F=}}ۻdoO";bIx+r-6ɖ82_sTD7FPE\ů*8Y4f1:Q' edwG@z[dúo5-9G>]CåMLF |-Y#v-Z%vIs|UL+\PqQ)[X{ %2!G׳{~v[2?eYzV8|{# epB^_vqbɤZv?@EYsJn*Xpb_RBz̞orM·YLN/kR㸽*$^E U8?[4;Daa9Ϊ#X5Pg!Y%4ҥ;oKEPu}i60W6:y$)N6B(]OJ wA,kI TC_- 6~)P!N 394r_$Bansڲ+_]B[4/g+[y D=rw;A?WE&w6 aeD'^7VCOqZ>Y^λZ@Bs ^R;v5r<IVZ!4f"!q )*Vo|MN|2._nWg!Z##()TP R490' +=[ƀ9uS|2tFJ܉!P:J L;a׊ԧXK*^`|-Nʟ $B%gA'g$=0OEHE /-Pe!M}_Dbw<0B~Jh"С꺻VB8-7l%ٓK+beБfm:5LCCeGTi 3qf (G zNyJ,AmvgEifzBIZա6Fz0QRGK6JJmƖo<'LSbʘR_V#;^6RnTuzg(MBpo^WaM6W^-,qf{p7hЯB]vi6]jj*W৩&a^`=JL$7J2@KҙTQGŊXĐ j_e7:e:7k)2R0JZqGanXf(Wvizԍ]{px.7SnP;hp3=۹s'n@#ynf1-"'Mu|-P;uzS>nԈu%m/²7L,qpduc@HEx{}H ̧FMvtV uye)ҳyk- <:gHmFg*Њ€_) xI‘OӻC`DrʹO#O:u[Lb(;8%^Z7am9.:+'b~@ *GKýwlKYnI0O]r*wh ySUf?+hԨ_ ,boϲ`:W&c`.#3S! ,O"EK52t*ڏM?@35&z7M Ƭo 6aY2"ZJ|w- $+BI֭$СKLײ JGd(?Q7Ԭ~Lڠ@^2ؙylAc[T=?q+BT{Ȣi0e7=HV:e[u4s!nQ.I#9Sl%] ئylI+9zq1 ភ:׹&{qDU^z)s{-e,No35`~[."̨OEҩ2ė2vc/!]lF+  ,רǃT:SDD5mXP+F!}#~bxEBb*x%R4c3qbFCl|; * axc#@1V ~&%!q^F+g'AwYʙ6bkXa`F#(< p\?iDF \@1 bu%4<~ #?&}u~}IJ RbK^Qȴ[JwNsl,7 ?3 Jb`k lGD@ !UD D)oYM8Ni7IS-iZ)6TYHZ4# St8 `!c0YRR/|~ɚU'#9)mmpfY<(>o-AKLJ 5R`eRqk kI? {R \̵&`H2!<`˩=0Y +h!ߣ~50]*6!`bA"o m\GwE$ &cfHy^﨏xK^8S&NH& %'2趱wCp}^+`,Ho9q{U . V) $eY2A˭md$ Ieh<ܗ &誤O;۶ՏWCI<\բ6-S-$d3]1"N_5sFC96ׁv*Pl-1e.ly3S;X!HǶ钤 M,|&SL e7dDkQ[>uyߐiN!$11W*fm,7T+ N0mm|vV 7l<1{Z%$VLhmثgqCv&m`BLOw)?g#}@D7)L䳺I8A'أz:ܥWn=FI((lҊ)K%|љ¤mp MR`X2d۱sZW{pEsvkbxc.!KbK*plS V0Wi2$= ~ ,N ,cM]A4UFik>e',9>t}Z4^&ސ} I{n(+SYo^{,+Y._CgT!Q^sKE䕊R|\S3BJsA B+S= 9:b%bŅ8|\(|73}4h^9֚R,.p)1sfsWIcLe:2g!yP- PFLĢ=Mh=qjo" SZx7*<Hgӯ+驧-+} ?DOVAt*ȇZo3W'^ #"͑m B6ٱz.g!WZ5/;I(}\ 祈\ooz:hcTbDia72If`_( BkNá:VڔL7' _Xօ-yb4$+/Dz( Rs-Ȋ$0l3~d ̼5䂸e[>ffodxޏvev+fi ,}GE.B[Ga[rg#5< !_2T&˟( U:Q'!bJۇhBk^Ɉ1M#kX٦C- *p!_P&9`L6W .v#8}hj%,D_?˘_8܈0h}W~1Kٛendstream endobj 307 0 obj << /Filter /FlateDecode /Length1 1661 /Length2 7705 /Length3 0 /Length 8801 >> stream xڍ4}7U{WڵwMՈB{Y{RjFvQ{jU[Q}޽=9's\_NYt m6P $ ( P20  a(8oꎄ!\$KC F1%0 p<@$HLRP $(("].P$"fB+ IH6;Ca @ r:#Bp| * zyy w{n> Ї"P[`g0_ 8 uAM<\ltt&@_ |?@q#oc0pv\v08)F.p$m`y=]w+ )fe[E3$ AgN./Ov0[_ez\`nPu?:hJP7[Fpءˀ?$ @{@[AP=̅hj=w7\M?@?, E}Q=b#TP@x$$ :wQ]0OvQt.3 7h>C\ ^&JH-K#;>4|@wC U5ZP[JQ`Ȼأy/ x/TyCmua(_\{p TwV#C } #-7q] _+($" } @D~ BSpA&t;; `WWw7=7.,^pTpAh2m'$tj@$(l @_/ pt= $D!ux 1Dp_ؿ pwG_@Ͽo;( !XE@_d-{砉TuMڶp|yĬ?=ܐ |rߚ.{(-~L,3f0Yۜ3d:B[xfMrPrNʒAz"ױg¶2{L@nan4vKPxOgUߖ< hrG'}G=BdV:{j=nsJ_m&{-Pa0< S߱Sk QZva&l9~dE4\| Q]8밝t;-m{|__*MS]ζ߽:B0RM$?M~.r>Mf̣,ӘCtZq'%NauJ=gM4&)0$37"%p:(g|X%thtx`ޗDҺ;zn[&ٸ,5;9Xjs>DO5%]o+M.+0 ( |o{׭|SGɠ5'0dΙxu}Da3*9^ lJiUOcd|s֌ޮ!Bzv 7%9 |ZV06aqWqr"xcЬ]:\VcpϜ-9J輇#Ek/VqwO]:|u{[&nJZ-8f?F6%μ/4U>ҼZjSRPK#xORrvoC]_h33?UN;)nI:ΑgVI8H KI%渤z,7 Nxi()^ gAڍg2@xY-6-*#Ia: ,w_Mu>+ԔTv9{(Sw}P)J8Ʈ-DȗuWJճ,/ Rl 3Fg.y}IOcJ˭ ޿VZ[SS ۞عzJSrV|yù$NOl[ꗺX^ O)Jl| aߓbC i "Fjxv%|gjd)V L%˙Rg _?[QYJ+l'.J*W"by$cQ/n + ko ڜd'W%,J}Aqzj5nIz_vBl<j˩r&::170MLN:4?*f)e|uq4NX=؞|o~ؖg~I?y85]o&۳'1VUlZtƇӦ<nysK3L +7r87gcu("[ُuT\afaN&foUl+g8/~Zg'Ēކ?JwCLR~Vo:j'3!o`RQ>Sor#$a­9`9#j>ֵi䂮bÎha% v1az\IP-ᐋ&]~ٛvfp_@K|xe{QE ? T}Yƣy^ Z1n;Nk)F'ix| ~6ڽWGix3%u͇4HmP]v,4<8-/}V.Dvmu̼/dLY9CF&?Y'ն/O;$~sAN-.k(?Bi7FÅ^6;ɫ[Dqh]5n4Xpi }8Qc8y Y{zѾ̋ Z i>_vB$\Y:J,~],Qm8\%CW6ѢTTa~ef ?73.q2Kj%@iZ7Qj˥EQ0a;}՞s?8ڕl26*-:T*#]sU i"Iwg癮pz16+eT@S n*V?fR:](q:k$qJ= q>Y3n}qC}flrz@?tē-r;kO_Y-ǵVc;WAOZF)(ȁrfP[5w5hD+iJϡsrnR  v5<)E+Y]ikA7*dtѐ$#*}_bUqF+7v59Ώ\+du3\-W9ōwZ É=9j.?mkc4i>B{z%S#ߴ^?./0ˬSjtڦ1[fҬ*F!+Xɕ~ e+EeΟ~@zjkS~OM35FPjjڀ_W؀SZb>l*ejJ 't'>-*m Q8  CVxGԾ˓v[2C0ʠهonV>Y㐄.=. &[r+"< ? "m8\< X2՚ZK|RubM҄V̓9)4pRSDu)|âhH/΍,_HOs"66=X %#]ɳbx#ВG/^Wl+I>||v1?ȠV!B`{Ji_ o|B.>װ* 0 >ge\nC)2758#W\BfmˆS+K8(R83mѕw?WWْF'B͋?WɄ8\9c p:`,%~`TjN{I\a븄#&!̾GOw14MU;^˶8wnyL6@UlKIgcq Jq͒ܫLLEqwQDb5>U!Yh߂A™^NyN;a.m^R'oa=MuhxC';50;YۈDaElQ'NnծЃˑ~^l/(Zܺhڇ?uصCwP%8a3Z6k='Z*TC"?Gy7L$d2_H/{΄QQM?[ +"KzYK6f ͩ4cȩ"bNT~cUKyW=Az=P [[=Pz g ~GķF|]{1$]K{Y=^!v#Iw=ܫj 6bp֣rQӇxK뻏1G6Y.8=Xd 6:ãk)y&ZQ<߱DKIA.@X 6|zZyo j,4I&Ey0\$9Ig 4,3{Jҩg?I>HY - PjsL+l~؛;IՊ_OMXnDhVW@Irc %3DјRZ )u^Y`FޟX@e~͞3!~Pa2ݐسh, mi?Zt5O)WX#'"eJe ٲCSk\ӾB:=ޅ\9|~$C`V˜xKo1yZg?|"tdG&SOZht0qO[r)xd2L"_Z.v?R:4h+#YDR3?MS#b 8z31,v}mDZIwfGeSze Z^9BW@6M~9HnLXX j'D•P(ZD W5ҽsJ3] 40'2oo%TQ1{cF&MPВCKwL,)d5ļu'"~B.YЍB~p$톹5rCh:eSMK|N=ͮ1gZ6Ӵ4!KczG(ǒ=Y 恧o弾gaf T'x3Òn?"zqo@]puhHoRY\0xruʼn+x+==oqY# >+/6^r0)."n)amrtWE[]M]fN Gz]YWgL).󼩺D1j)sIA@+ҼN^÷]G QČjk=n f{Šæ_H<"Qz;Vw`O ?k{]68;{v n=e`t8{0BڭV!;gO~\ZT pw`,qyZ;)2{V*Ӛ)"-%Mq U"%z'ğsPwC s hXX1ۜ'L E쥺jی+?z@[cE=kTmXu45 w>O<7! =;wr"6l|Lj\C1J3Y'}+Z7z?)Pnϐ_v^~SUpҝ?A?5b -TfmPW48~Y]qx/jk;LޑseYoi3J!cN+p[r.obzqJw@M. O\R>4j7WgrT^qؚ⾟@&|ӊR*G_N g紝g0Լ-МZ3 w)D;&>ׇ)cY? ΩFVT>3tXL;qDt& Oo,^hznҼ3rn`JDۦq 7m>f5we1vzv%idwMSlz +D$:Rh]S3kj]NTܡzIpAXՐMOrJG ) օq~eq-(aMd.x]p:D '0Z{B3;\Xf ~mH,n%¢滌 ;u#?s-&lKyy. GB:.Nh5?5?r'endstream endobj 308 0 obj << /Filter /FlateDecode /Length1 1401 /Length2 6158 /Length3 0 /Length 7118 >> stream xڍt4\mۮނ蝌Q "H1e1z"z"z]H$I9kZ{pkX"-`H$ (S5  pr$03_r(CИ8u$b @ 1 AA( <n P"0gN9 nmƴ ; C@9`:B!]$C{ ( @(ki{78s\a_d$=. A= C8c2\0t! l ;"!8`4{W ɇB LC2_(#Yn "W)+ ,0ڙ(s?C ^-K_ ,]Op'_!?6k/**"9`PzN/3#`[0/g+ F|+` 0k833|`, 3 ,{f|Hw? @BesmՂڜ?UVH?07׿hdxp&`A(UQ7bo!p{0TvAcdĈߡOa8W Ca8?HD@PwYjP?D{pL u`ˇQs8cÈ}P/ E A"! adj soPDcR>+$X@ 9`f70^; |DBV7(av:H<ְ3zeF4$knYП(ttқwǐIkz|rKsE?fdKzBz˧?CڄKr/׍o(2M8K>C*qʓKHxwن(3㘔$7DKBiv)X~hZwF[[txDmCTuIYw+Biew֍ΕՏEKӎ F5 #~Y͡פQJ庋&W#Ef7jH a!fGp1]Y&( o+otTߧF}8bWdS 4O\_`8vN !?p:s}"BCK}*HCJ9޼H9?pɄ{Ww]ҮpoxPQ}Z?r8d8w΢oʝ!>Ўw uD,60QqI`N~؂`VLl7%S(jr{ѾLapd.3KJ \&3мP6%ꦫ76JBR=8oZ9s[1b#As:9єP%뀞 Lp(7hs3n@ĺVD虊z!3wuhi'y3b1YNc({Y D`'R֧$UHc>68swfݙPWu8gWP:}%#rz x^&%w?M$0#VeD%=^նX&Cv^\;s kGX!o : A}J/ ->W.ɦ x|s{|}w7:>;j@͎I w%7xbT(uD؅wv?[̬ MүRMt/(IQ{qFnjQjIe!U9{h/g {+'PHJK ;(qk-wݢ<0L+sbk[bǑCU'ė"+jOKafTv80&,3hc촍Hӵ],!Jϻa"sgxQwK`OO!B&RAK~Ӗ6Ҫه-3F8)dN( <]d{:7=% ,ѢgKu?~3\6p<ȚhUȝ4ns8N+279RZ3_9}z7Aʄ-l)NQ&G]5"cȳS YB D`i.b!x/Et y87T>%-@fp*I\ PP=_d-K IϚ?ߴ ƿyOH Ju^;o*[~[ٜ/ձdZ߷[kyŮ60/J0`mJrpsFoQ2Q1(nݣI5YdB-G[YN#zEc^'R!z5x%U th"juG'&󾆑C5<3&w"m'ݚ5o x&u#zeÓx66t;LfЄo U =_/- hEBeҭ}wl0Ǐed͋I7X+E&W출ڞ$] g~hpC^T;ݞRy0r%IJ6Lv32bz!%;QUvs|qa4qZ͒tp@ &U$L.C|`.%|'L|ĘaoAf.v?eLaՍ(#-~:8-8N;A nQӾ0S6kӶS_ pwG c1[?F<#d lHGOn}k槓b&|KƯ#ëݥA.OL+3˜f!ͱC_UIW %Prۓ'^SY8lJ)w+}syݤ_ty]5[ӝ<|/,hJfa\P nfs"ObSȷbܹ>c_&+xY: UoEOS6`xwđՋK"5,E|=m*aW^?o_ 5P[7L{{K%*ԶlTni r[A^=Ȩf{u?sBiEE?mJIP~RG'O! "" |ƃEip*]X%#^Sy4x}pQx~}Jsljq$a'%(֍?ߠI2]/<Ҧ j*r^?XL40 ۄ'VCPՄ)pje1ck VDGS$;kqwhk4}I{BBiye|%-ڀL i_yQ yWgR6:Xƛӹ`3]&?*IZyqǙD44SkjuU>i [ݫe??B;MGLUo+i=z2 Gʝg]YigQ p2n (~MT5Un muK ܦ<+EMwPpEmTlaNjNW/O˒`[u|یbсFcyUb2"z/3Շ贔'v['5E&4wֻ tWP9ʳD꣇H.P3Xn2|)~+H+,H3bM.gk4+Y.i\툧C=r >})NR]WmrΫX>><zoEqW};D) nK'BԱgt9EqQjRX vnjU_0f_#?c*ӤdW;f$=7l~{y}TUiٮ5y3h;q3?,w)Ue\|xry {NQ2a̶cTycF*%y= 2aCm^kA+Cv}cLfqQ~XPbE4Oi$yMR8A;4R%8-pj=X`J и +(P\0^I%q=&25GWVWp6rNii;V,|$8sF3ʮޣkT,Z+!Um~юGD͇ CHh@d Quu,juze)bJ(8OQ|&M)qXIb疲`M"` aߩUx6eLF3Ș:=ge̘nX7{HRɶX0Y5΅J7Lpo^nFQqĠ}%HCVE:!4o壈*=Uϯ*auqc%=*IgӠ"Xw:ޮcVov8l}ڰͮL^wq}+m-EK)| իks*U6yR;*-U7XIu~0aerFS*vLNy1Dq*IN4=Ȟo5W_æX8Q|!T%|cexn;Z@bnQvfPh0S.B 2vx`^ۖ(> stream xY[7~R^!Txjx݄"u}Lɺp\s|j%Z)a0hG#Y+H 4Qh0Gh F-am`i^xi1k)>D`4]ZkSRbavR?<+A,%i5Gfٰ)͆c3lI8a=lðr]#f<ZhT[hG[h -4-4#Sh9:^oG/Y `ӤvFA e5!b[bnC42)]l8p*͖C X!WK9PJ>*hN4E&YYdH&9Hń3ĄT9'r@%)ES؆XM$PpD/R^ (R L \RX1`ICus[8g#jHԱR x #MIݝ$=;"8l0\EvU6=324c0򡑺\cQMN 3F:gbAoyDB8֍2\WL$~ !SITش=TLIJDU)Ev6T)GxXј/72#\l+E6-U/Mʛx]f_Zd1WUt1FVʔ$B=~)|US@XvXx\hjMJg-0~_$UÇoAemktҶ.鎰4hhU= FuN) nv~ ŝLe"3 4gTҎd'\UmK Rp.hB/>E* &\ϴ["%]}Z2ce{ɀ/뇜tGg҄&(&H;J yrDPPw6Lltp/7Iԫm̈17kk/ŗrD/rI?'~?`nz'ljݬ~_vm0gfb6jKoQg߷"KYz}+#\%/7y"gn2#Eڟ i߮-oݶXz"y"#u"ֳy&K]usa7dd;o/bWBw0?qva\}(> stream xXn6}W.mmܠC/ȃb+n+ig(>,%Gg\8(J %C 5FhB['A*@f9@tȑX10A2yAv :>s Qهhaxm a0Ƴ0S ,8, d q,2`Y#=G99#S9#5{a@5#xd)̩ G ^,6Ĩ# ?WϟٮͺQ7qFx1%V)~'2M#_ĻKa"ܷ yqqowCZi!ӿːR9{n;|FoaAO؜?=2U 9\T&goN|~ΫIԐs5ruroGWms'^ö".akgS<@;rIs݂i,Q+XaiYy{Iyv5뺛~}+f:-P2ni̩g+أԳěӞ?b؈Z\vK鴬0r3 m$ƞ6ۻv}Oʝ4֨<&_j&޼N ;ipyYgjCIe< mx(XB#xB;ì)<ղʮ&{Z*X7FA5[:g+3'V1h(紳LEM~J ˜ЊǪ;_f 9Sl )3U`rucm^j7+f~5ἴk"j=ƒ L/{Ttݳݧ_9t~Fr% _te$)R)ZQ[TE>ph[}ZRa+rsINNGH<_JqiIy.teƎ84^r.I*43\MH>8U$c^7M(ԝrq`V%INҾX Lc[EPa75tҤ=ѤkAiI 2BQ8uqL\/FYB&VcXvQCⲇYV^J* Kayhh)zɓ)4Lʱ?qXuО}O~^]M8lqzAڻn&c8ӭ 73|mS0m<1(s[˧ٱ™dPrn>> stream x\ms_q:t|4N+UIh$4t ,xdYIԓp fEdREf`Z)<%3੘O͂8iXOˤ0?RhY JS` J0*` Q22%iJW)1QVcv`d-=Z2hVaG3-, 6zϴȌ F0# UNhE=A @41`R`TA TQX{Eju `j}a NecN{u<@md^ hk`7^i]`pM,Rz,hb , `"xɢk-**,EH୷A_9#lսpM/7)H,%E0X ҀV IUa!A  $~)IߒP;Ry(IЉI`#Њf2"Ў%b1#9b#!`"怌c5i)Zj?}˞򨞵,rxrx~}̎f^ CM zV.uAe(Bvh,{e?VjaB_~uYϳ~AVlm_fY3<7/eg5OM5":LPT7a?ce]ܡsa3@/ WP(b+Y ЁW7o6w xU[ros%E {h:b빇-8~oe5^6%w!$;=kC,F֓9ǚl%?޶ߜy[2:*R/JvDYȾAtB ;. h|>m[636uq^#Pm~ ;X4,ٔ93"ѳ/Z8`hPGghԣBeQH}/vRR7M>aΗ |~/v)iy9y]UcfE=v'jG֓GOBaįֳfYuyY6(mej\0eݖY5,bQl1y^,\YQ5rz9)߲&#tM!uє4_EQɣ -*BK5"E9&Fr6Λt/a=g%ԩ;ȋN{^|X܂#<- "jQL\0;'`Z~&5m#9WOClܡ\ˆkS-[ըCAMRv=Mj/(OyU 'Yld7w*v{W[pTlWu[@,Id\,( =D7GʍH=[{wlnkyNVKC7[һ$rM2ewѿ[uV/" CBnJWhi%\j4|/N︸rꝈCd=W1!،9a`+2g0.Rnआ$B䧍+)éRo7Ùa@f%s74U4_|ғjhfh%㩠 =`%>).+1P9I( HSp)EܰbոW(NΈy5€v7V[m{D[ao%6LH\vg*9ܙ{?a6`[eWK^|3 ^of:mTWOȞqB /_9ڔ'7ɬ=.Y?-/>+>+N_Q0xV14^A"Exh}6 J14V3⩬G'<-|$Ր|2)'۳Ta0.趩W>r܁rnD,:.$|=K/̋IQ RZ.=dAYi_RGePcg{GlvA| Eg)UW|\ˋi9dP*vPzAXB|Z)=2:ѓ f,@ﮱ1"p*@G! itHPҸ:ۢ09࢞f'˛*&e6\!pBy$ "^wu6 ~%Dg!q;O4ɽ% tGg!(w ʵ$"= p`Qjw "!Be=z,c踈e:v>˛U3hW5Hyw;ghXNy4i 5C4[7q[o щqOϴtjz2.}w.s&=S ~"NĮާ> O}f}?je퐪`Wuaeu%Ua}~L[׆$p iH{)`r!dH5 ށu,;XEj&H$=~ptZd*Dw"5f!0ʬYkS%h4]ieo|"zxk| r^]پuvQnb]z#) ! 33ݥ8fDepvpu7YIG~b$[dCN5zˤ>v;8+)CtamaP/eE ׅk"2)2]v'(tU36ՠ]*Ekt,\ un Un砩?᪝r(R=cL9hL9h4i\ߟrR?.͗'=3hHdh%ӑntU2|)G&)g$/YLl=V.ø{1^SF?}W|R1yޖ17.ܸFD|/"eendstream endobj 606 0 obj << /Type /ObjStm /Length 3343 /Filter /FlateDecode /N 98 /First 911 >> stream x[ks_xL%Uj+Q%4 Qh(B=\PHVfш{. L2/#S:⚘y%Wz,xa\-S}2xK=0<3jTP5QL= BXm=MĂIl\C)@98 JxXT^yusE)% H)$fYR d%K5f=`JJJ娂;0dAPO%At A@ciL@ wІ@*І2pH! jvdAJe["|hCHmomV@'@ІT"kVC&u-0OhD6LAM`6bA k1TA  ,ݡ ӷ2Sz`bow=<9%~EPL{|TWi옉wEhldjuYe_xq1oE}׶{漮zQ*bu}Z#DqٰP3=a r@;Cb8ex"~CwNW34Lm MݔB,Ҵ~;wiݜ@ٕE(ʉ\݇ 9>dϹeWs]T ;L&Ţlf,pԣ+ч]7'MWBr36:,US8hyOm7(`ylF%m ##jY5,/c k%kRp@1qd-St`&Pzk*DN\ܔC67?Tw ۠/ ltԳ 4/ "Nk(/B"NQk'P%D Z{\|=QOpôp5X;`4M"=w:"~XAemk0'#ȹ!+ 7VE >ɘ#VYIj0[ɍU(K6HX8$Z\of nZb/ed<츸L\P&Fْ[ρAi I0F rM6PP\?k!ZyY :jC:Yj+c|ζ2\E\c΀vn:.z̸+v݋ ժZ^]M|u #}ngheuuί94իДTVW\N|*|Y08Mz43" v<ўvmX0dVI+Z˵^\ >An膋 u m9vڧXzd1 !Ct6v6ǚ;Fn4р̗gUm py=@hޭϰvk50h]O={{W_Txۛf*m>l7U޵o!܄6̻0#'/bNO&yֈnxӭgw\h)qVNrݷZsKA|Мh5v`Z7袚!öq!P0d%~SM>jlpkd͹h@tl3,T#%u##D=e;& ppM.=8%ϐ ڼL=Abh9(Zm!XWA!ؒ ] W:Aji$K.j ]ɞ6hCE VbtO4 LhM\Pڎ*::ۇ~^n0ewrrsx3f;ȣ{{G9Rx8PmRӹƃMw#) {@ͬ4+ 6c<{3娤p i).ќ\\-_&.@%RYz7rQ lTQ]{{RN=^[B!vw1u5 ׭ͫ넽Hl9g $%<´<_бL&5+&&M+/FK Uhyy>-?0c$]V5Κ2d1qFcs&V4p:-6/I,/I=+aGE[r;zjywkM|"C&kFDt)Rvz!!(."3o@-hM$WU6ph 7x?Bqfo-Wr 6-q=D.1v@a ʐs*jn(t,\T\mI<@!B{}i~i]er ={mhD>e/F:ʅB܄ƪ7K˧VaZ9CkYg)+ZMOmHsmuda;SXZY66pC N;P @)/l.pw}/|>O ~tdͿN:}+5,$kbWtmn\h*1)%.-7[\)ExQ4w^0hKJvbZL̮J^^j'/{YycDJ7j=Xjj6A~<,&ؚ?fsn~al}\x'ѷđ8'TL ܳ(?ť8-B\|(gSq)fb<+y5Z+qU6U=l*1ꃘOXX`棺)ů⿛jXQx 胿ڛ~}'&Fendstream endobj 705 0 obj << /Filter /FlateDecode /Length 1719 >> stream xڭWYo6~X!Sppbh&yw]5ZIa; )eH̐~,GlFƁFףB!) r6D> rfe1sy$m"V䢭*eUǧj1 dZ*JjsRr7Ğ$i"w 5~98iϜ8QgY.iv߼`rK;uOL_=I27Nx"S$(`TagTpc_2.G>4]*"R!T.luԏbdቐ4Mqr0Oy>{p2=n+UÀe -xb}w74 W*owt=p-A ƪGFQvŠ7pqتm0kՐ)wTiI|5:[pћbvsX&yX\xyiS>~ou#O$G%/u.!fmf7HрYD`& 2J(rs.8 I~Z,rؾq&bݤSˮ[=.eۤ|huDu7?PI݊6um=V(XmL,5-5yQ[C*%i>D"PT?egxa_)oooiHiXx,"T|;|s0s&À|SI@}'E{#8dGYvNx!9[fBz*Pgx4K512K -Z ܦH8uö@73~1rm) 9+~,ލc`AMl4X."+p46  Wx/Z(X7t}n(\n!v4vBaVW,RZ&>xŕO@Bd v =ǭ%o PO 9M@H> w[S-kLgy /nMhMĖ["n5ܕ7rl_ &m8vds5SKe*NUڎuVS jSP/p2Úf( InF trӺި-#)_' 0Vw"3( ⡄G[ZJSFraft:xN2V4 wJ g stl.&4nvZO1[=!٠3jg*ݸV-7gb5 ܖ֛ We{4x {,ZLg9Px'xk' =.WA;S޿dvendstream endobj 706 0 obj << /BBox [ 0 0 504 504 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/home/renaud/Documents/projects/NMF/pkg/vignettes/figure/NMF-vignette-heatmap_consensus_inc1.pdf) /PTEX.InfoDict 181 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 184 0 R >> /ExtGState << >> /Font << /F2 182 0 R /F3 183 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 8042 >> stream xMu}} -i,=Āa݀A0&63 {yG⥞5f1=JǯϏ~1Ͷ=~jѯs߸5x7o6m>IߏGߟ?7ݰ6yn?gҥ~xLk^,<]_|by5c{_m,qFOz9͸{yϻ/ik|緣̗[%Z}q]3w}sʭ-N[1 Gorkϥ;e(V/Vm16Tnq\-Nf*ʽ-f-N oq %-VpOnS޶lnآ\ym:[Jb-(V^[yK?gQ8Xy]\lqDz5Xnq\EX-NX]-[[}NoG.8cՋ[[}v(]{i}nQY"sG-ޏ ˕{[Mߞҷ[ѥ٣\,(L[Gvrknirb8chϷzrk~G9oGn)8ۢ?1+yytI+鹡gbGfj-qQ8X%ގ2]nq6]!rk/oGYXs]NX/Qʭ->l[RJW"s|;xiC6}q[bvj[l.8ۢm|aⴏnlBriv>ʺ]nqGߟʭ-k[oGYOgʽ-Yp[^%ʕ{[r8#)/iB[ߓ[Ǧ_⧇OF|JO?ؑtS~IOSk>NgӵOXx6?_ ϞWn ^; n -lmv﷬cnn-ϼm-/f훡uoɼ==9W_[nv>}=^? 0\5s{?u_úrݷug~ǃ-\tz]fn W'~Yq>T{>wc>.z:yߊ/Xx+1> G L-ntc {6:}vO8hvo峅۶|R}>-}_|?)-\u}~x t_}ᢟ3bᢗaCvu?ge?>~q?98⮅~a ۚ?}:-<_^% ?}U?3rǡۂЋgL\ {?U<}v򋫅}x>Xt[ӃU { }=4-D|po}_M_\?[҉tqlᢟn-z{B_5V?/;9}<=>/s]Ouoїa p}gsNo\ W}￦狱PÔ\^~GhK6j^{\R/WN]w nϨ)?[rf63U覶0y<7kt)Uq[ug} bsJhۿۺu Zn} cnݜϻcnCzV?vM3ܦ%#-m1vK~{o[Mts'6[Oma~~n!܆C66?ă''t۷}kb2".x\wVҭN ?&ǔd M&y#$54I MRC$od&Ij7룆>jQC}P5G-p@g35tF QCgo:Ψ3j3&*/sK%v9Ψ3j:x#g5tF QCg35tF QCgo:Ψ3jhFXcg5tF QCg3j:ΨU8gL;'vfO3j5v;cXcgk5v;cQCg8cXcg3j5v;cVM3jg3k5vF Xcg3j g3K7rF QCg5tF FΨ3j:x#g3j:Ψ35tF QCg*:㍜Ψ3j:x#g5tF QpFoK%v9Ψ3j:x#g5tF QCg35tF QCgo:Ψ3jhFXcg5tF QCg3j:ΨU8 gШ4jL35G#zyF#xDuQdw<"<QHG G# ARd<"BQ!ȐGt "(G#Z#hɻ4["Y#F,Y 4hY 4hd1b"kH#F,Y 4Rd,Y 4hdJ# 4Rdid1b@#F@#F,Vid#5q΍FRs5fd\<\,"˥r)\,GKR /FLJF33EL=Sd3"{Ȟ)3Fj<{=xȞ)g"{=Sd3EL=ruH`FY e10b`(E6b`*l( Rde10b`(Ql(Q*l$0Jcd(Q,F)Q,FY eJ%:FY F)Ql"F)Q(E6J(6#e10JRd(E6#F)Q5Fi(Q(Ql"F)Q(E6JRd(E6j+eRd(E6JRdRaQHF)Q(hG4#dG4#Fyd?FYcFyD(E6JRd(h"XcFjF)Ql"Rd(4RcF(h(E6JRd(h"F)Ql"ղ%0e-0#F)Ql"FyD(4RcF(h(E6JRd(h"F)4FyD,F)Ql"FyD(E6JRdfΣF-2Je10b`(Ql(UFHQ6F12b`(Q(Q,Ve#UFH`"(Q,FY Rd,FY e10"55eRd(E6JRdžyD,)g"{ȞyD3EL1~FGj<{=xȞ)g"{=Sd3EL3TyjyȞY <xf1b3Eb*l3 i=me{Jd2uKVvLY ʹfʹ_q.ӰMiv4ݗ=}~Ctq䧋;<{Zv=cWiMH_>}jeږ~QEJ~Gx_AW;g{e۷Kumv?))oy~"twH}7{f).oҕO~:X/|w+fOt~n[ $盾bӾ^K~0Owt~(ڀϿBRvx^Ӛqj|ݟz z$x>>/_kZ;yOzx/p>;ӐN=_|rwqh9Վ.= SzuS=~pen0W{ZkUW{JK= m׌~yrO[៽$Sz̵{b;1/80Ww̸Ә^⟽rw7}.YuyɧwSze~jGo^'P?2ONgszFO糮3iص}҂t's9&*Ws McU&*|롉c2VCȟ&j#UGY uGth(} GDUGHQE#5G|Xue`t{KW%gkQ4Ru+Fj(뢑ؿ]u۪h(_Yw8HQߐyTHQ_:F;uGob:FlsF$_#Qmo-:F.HQ7|UE#5G߻Su~FQ4Rugb#5G:F*9~ʢ(:uG 5HQM .<S]_yۿC⧽S_q&< ̰^N׃>S_ui3|%v\NEr}/ܧİj][94'0DC4ÿs]ˡu DC[t1?L%?hq9 ]tm~nP]'G|hӶs4q(:(PuZ|y{܇|_ލvw;8~{=r> /ExtGState << >> /Font << /F2 187 0 R /F3 188 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 8424 /Filter /FlateDecode >> stream x͎a}_E-h,-al@u/hdֱa_DEjH&3#dfUw >o~Scǥi\mn>>ӷG}__o}-~>~oC߆icޖn>~Xn_bg׽9umc98bm܋ {zMã]_}7rM?nνKח2~4v(<#z=ƺCޗ{Ǘ0$Y]ӧ_U_?'W7<_U_?SzY"UZ.T< /amix _gxˬ[Y(fڗn/+ek=ݫ*ok}Fo?^yu| Si]>ux)q:^ zņϾOԵᓗ^l[(Եq_ yeTlx\׆]oN]}vO>}D|Gx;RL~mx9=mP qoNa w)L=Lôcڎ.~ćӑLLJʉ+-< arnCxHʣ5<\CxP&+ذ~鲈W1<.}iol\B?ܭ߸~\aV:oކ'R$B\yHq.)>Ԉ⢄(!.J⢄(!.JOqqC\7 qqC\7 qO7qqC\7 qqC\7 qs qqC\7 qqC\&\”Sf\5EqQc\5EqQc\t#.z5EqQc\5EqQc\\5EqQc\5EqQc\Zp97E qQB\%E qQB\%ŧ!.n↸!.n↸䧛p󍸸!.n↸!.n↸ހ↸!.n↸!.n[ .~uqC^7 qCb7D |N&'G'G$'G4'GD'GT'Gd'Gt'Gs4ȓ ғ#ړ###### cA RcԘ 5&H RcԘ 5&H 3AL#92AL#92Ay AL#92AL#92ALP^-y0AL#92AL#96AjL1AjL1A>w&ȑ rd G&ȑ rd G&(O$3 rd G&ȑ rd G&ȑ ˠ /&ȑ rd G&ȑ rd wk|HC(CM5Ԙ 5&H RcԘ 5&H Rc|L#92AL#mk`OKxDZxQ#H{s€郀y0` #Ȁ92` #Ȁ9"`kox5Ⱦ9o#Ⱦ9o#戾 su%LSc05LSc05΀92` #Ȁ92`>,i{;py,À92` #Ȁ92` #0|yk0Ȃsd0G̑sd0 `G'RZ*V, `UKXjt+)VSXLb`Va4*)VSXLb0 `kLkb0 `+)VSXL j1`j ƀ1`j ƀ0G̑sd0G̱ 0mc<}0̑sd0G̑sd0&kksd0G̑sd0G̑[05LSc05LSc0;Ȁ92` #Ȁ96My,À92` #Ȁ92` #X^c-y 2` #Ȁ92` #Ȁ92`% ƀ1`j ƀ1`j ϝsd0G̑sd&<a0G̑sd0G̑sl,0G̑sd0G̑sd}̀1`j ƀ1`j ƀ0G̑sd0G̱ 0mc<}0̑sd0G̑sd0&kksd0G̑sd0G̑;Hƀ1`j ƀ1`j sg0G̑sd0&< 0eA<0G̑sd0G̑sdk0Ȃsd0G̑sd0Gl8/07 sC07 sC|XXXXXX--!ArDrDrDrDrDrDrDrls5 #######c#RZ*V, `UKXjt+)VSXLb`Va4*)VSXLb0 `kLkb0 `+)VSXL '8-05LSc05LSc| #Ȁ92` #6 X>Ȁ92` #Ȁ92` c`y5Ȁ92` #Ȁ92` #Ȁ[LSc05LSc05΀92` #Ȁ92`Myl`ˀ郀y0` #Ȁ92` #Ȁ96X `^ #Ȁ92` #Ȁ92`odx ֝f_ɾojƾojƾ7G͑}sd7GohǾ mX-O}sd7G͑}sd7GoX?Xo^#Ⱦ9o#Ⱦ9oo}MN75M}Sc75M}Sc7;Ⱦ9o#Ⱦ9^Ⱦ9o#Ⱦ9ocoy5Ⱦ9o#Ⱦ9o#:UȾojƾojƾ7G͑}sd7Gͱ7mcٷ<}7͑}sd7G͑}sd7&kk}sd7G͑}sd7Gͱͷ#NoU|K[jRZŷ*V-o:o+)V|SXM7mMc+yo?+)V|SXMb7Ŋomy55XMb7Ŋo+)V|S[ťƾojƾojϝ}sd7G͑}sd|&<}}a7G͑}sd7G͑}sl-߼7G͑}sd7G͑}sd|۷75M}Sc75M}Sc|#Ⱦ9o#6[>Ⱦ9o#Ⱦ9ocoy5Ⱦ9o#Ⱦ9o#۱tTM}Sc75M}Sc75ξ9o#Ⱦ9oMylo˾郾yo#Ⱦ9o#Ⱦ96Xo^#Ⱦ9o#Ⱦ9o-MM77 }sC77 }sCo9o9o9o9o9o9ǶǢoӇ|}}}}}}}}˱ŷ5[^[[[[[[[[M cw|Sc75M}Sc75M}o#Ⱦ9ocoDzoyo?#Ⱦ9o#Ⱦ9oM5 Ⱦ9o#Ⱦ9oco ƾojƾojsg7G͑}sd7&<7eA<7G͑}sd7G͑}sd|k7A͑}sd7G͑}sd7&ߦ>LM}Sc75M}Sc75ξ9o#Ⱦ9oMylo˾郾yo#Ⱦ9o#Ⱦ96Xo^#Ⱦ9o#Ⱦ9om[jRZŷ*V-ozٷ*+)V|SXMb7647þiT|SXMb7Ŋo+)5`7Ŋo+)V|SXMboM575M}Sc75M}Sc|#Ⱦ9o#6[>Ⱦ9o#Ⱦ9ocoy5Ⱦ9o#Ⱦ9o#۲tG75M}Sc75M}Sc7;Ⱦ9o#Ⱦ96My,þ9o#Ⱦ9o#[^c-y o#Ⱦ9o#Ⱦ962T|Sc75M}Sc75M}o#Ⱦ9ocoDzoyo?#Ⱦ9o#Ⱦ9oM5 Ⱦ9o#Ⱦ9oco 575M}Sc75M}Sc|#Ⱦ9o#6[>Ⱦ9o#Ⱦ9ocoy5Ⱦ9o#Ⱦ9o#戾~r_Ƈ!_Ҧ-Gzٺ2>?7?!ubxCCyx;clXaء>v\q?;Ns>nyi>vϧkz9}>!mb9k7ccJΉϧOS2`܍j*sF|U~9/jn-~q[N^}>m<|닱 9^ yxr|>Oϟiigwn=}>!y_C?SOmC?Ӻuyw<9ҭ硟shٟ&!kxW|gru7t>wC+ep>wC1TgTwCnVc6S7vp|o08(x;8LqvpVv0vpZCJw;8L~yW?޼ [9!! n.Ezv7K\^ʷ!5monuyWr;8̰uy;tf_a^Oa%ݿ ae/4Nvp`svpW כn WHvp`G)G8a?&]v/t5秺{p,n'x˼ 7kQ=5fl<ukQ=Gj;kiQ=Cx46m:nx8;m:8uۃzlqÅzUߨ~q㷕סנg57S5S09_^5+@9{fYͿYc[fS2MئW=4cv#mئ,m:6`q='-Nqئh:6Ut\ҦzlqWڎM_h:6? t\m:Dt\Pq==Oz905! 3W׿o6ߜbτ7[M^x%߼5w-׻kt׾#?_sّO[Es.\._wܧ-xM<ˠt>xg0_NC9xN?p38۴ Ƌ[V%ӝ_n~b}ps:_S੏P,}|YM '>缅ˮ-}&3xoSs^.3lzj>ʻ=@7].C9<~(@}Ky+c?_n o m;<z_2v$%t)3׍pQ~|@bO`O aLp\`_K+}ఔ^h= +mMwxi; W-4<a;ϟgo}xi<~4 ;c(mK<^z?qg~endstream endobj 708 0 obj << /Filter /FlateDecode /Length 669 >> stream xڽUn0+jHz9H["ӎQ-۲¡<̳G kp51>F " P=%殁a4<{f 7$M% 1=f$BD*"5v +GYm깧ÝP@qNPqp518Al:(:Ui 2?.F`PWX!%܍LцMn"ۈm.cl7seUduїU;_\0)?~Q)ٜ< Sƈ2몵U۷eh {pE&I%mlKʾ6M_pBq'oS]4}x·*&#&#Jgr͇W8/_{GFI$Z{;~1.}r#}+S\URSNSezA5Fy&xG0 1ڜsjL:uU:R0̌&˹9r%an7߬=;|޹0Q{t_m9[T땋`. USg4 hsYWE.]f].dQvp)iumصIhHh.lH{ {f8z ᳉'8UD2 $ꈅ gendstream endobj 709 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 710 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 711 0 obj << /Filter /FlateDecode /Length1 1675 /Length2 9564 /Length3 0 /Length 10645 >> stream xڍP\.=@];w 4H7@ 8KN !8Gf̽_^u-^ka唱Z'/@N]ÇȨ92c2Pؿ@@أM{SBN^~G?P71<lPB! wLF9^,֬^QQa?2 75PAΏ+ZPk0_,07ٝ f': w'[0@ S&#@]j '5誨4]@? U/te&CHZ[C]o0` v4ո`ptr>=`'c;eGsvܹN%ryF 1O~,7'zA|`o6.HEG?6; #,*@pk{z.?͏ }].G - <@v7؀a+d'~<|70`{߿ q'~an`}P8_'  oU ko<@l?%qHFqBm/o(l p_P}$ >AYq+܏\P >"?r {- _ps{c k0:*/IY],VNen\tW!n2?m+Kބّyw2Yn'4T7Ajz{~\ {T \=Dp {B/*f8̂ ɟ8/f hU1K}M6}֪{)(Lȩ ?2g-gΓvOl::j\`bc F&V[PNq.KA;W!nΡ~tnoGg!i0bԱ'Io FR#72F œ}6^[#nnŵTnڲ{|G7 >2w3yD|::Գ7nLa"_ב/NKژGq!NJO*Y ky7,A/̫2"J0["7'А,n{KiI79^B3{˕5bU|5/Y zq^z͗k%#vuGV0Ԕ“[|gJV8v"=^4>z<)zYz)MAN |&ݚfv_6ARYLH&s%DBK*hE@]fWH\Y3= N+z˼ihZax.J#uNg{ +4ulenxW4vvCCWa&u+fK~4HRP4j'617gt3Xy!y[u\L>ɬH *j~_$.i'm:m?y:ʉB387r6<Ƌ6> +"<|gpt(E&^}#*qހp*MTj T;rܓ +ba-oUWY`j,+=}S엛2O_`=Q^;Z4*4c#j>cHw޿A/hRqK&]"ay-(҉^# w5MtQ!fc1>'$T)Sb&VIFyj>{FSϗB$gߦ?Y:aԼ5ݏ'$iǢP}(J. b)xbDIcst)$v${"ک25} Y=QruB\lY.\vN&n40I)~1R7b6+1Q]",/92<)"cIv̡ZA!$q,o¯.xSuПu\z;XL"s>yJ(gdA:%DH?:Aw^ E`WTV5̔/Vv8ԴRi쒴(#̟MfBgVqֈhgRutw6t:XiQ9lh=;{d56DK)V u7 {APge(jRVt!R)Fڈ\̰ ͯ+p Ƙ',tͭ&－1k}?I/r&ͦ__CqO9Wh(>LUNҫ4 6QL&U _?S-*5gfSyT0,3B#^p z!DTS`mhϮO;:7C-n %#  4}wsvɈ4jb_.IVj]KOĶyi?Fv, zOZqV38-Pj=ѿR%k grĮ2LEzCXl2sP˲iP>m 8}xH4p$ զ 6z_MgZ7BR~\_Dt:e}6rFsNJ7V'Эݲh&R<[6#v C_Piqjȼݔ%82OƒV^+D5.$ȏdET'"}F zfآH3؛G7xލH3mv+ex3F!B  ܍flCk`]%|dF*n4ڲe?C,)i饰ڂ82(N^nfB<'W ۮ:RbYoAlpNQmxE7j7H`e&{,p*.Lw _û'XsH^ag Ӫ&aI@&]"7L]/q«G!,UxXV4u ޝ\z)ֳ\Ndml(,GTD:т t|,,ZגV(PҋJj#UǼ^j9E^Á'iʖ2!bI٠aI(Ǩ;{"/e_7w}9+j5z'ٗ:b%(2LьT(=9f(2=}?] KUey/su&Tcxjm)mj35ؚ3&j‚wɝldѷ %G7i[^N6l?=3$fRΊJ=Tp^H0ķ~V65~PǸ&Tб]u*E{4Y™s[R=Ӯ3`1[ʻI 7XWΦ^l ,2`=k)"Muȏt]).ZjnGd~ޜ?D`}7siGQО`~]KcGih\eޡWjk[B{P\OF#'Dy#ZJX4V|Hjh6:Xg..%L7!)D+T }>aNOX+̭eGl C/uIg*5'x+Zż%&n+O˽QV,Bmτgys_n3%[r,ÓoXj"FF%0 Ղ?J!eE4\@YK~cqM#?x jmLg_}3>(O3ٟQVl)dP4*_*c&f*Gݓ8]t* \0CEE k4sY_z)o= =z;gK`!W|2LOC-)t|>JDd^9Ȭ2#dlkK-f8f =wTkuF#IQok|{剠(pbz̅W89k"OE =9I\-ɋ/3\,/6oHf%#B:I>%L75mJ;Ǩ洼#KNK>H+-{{c&a@YU﨎?baMŴ$? zєݵA|>t6!;ğ5#Ƚ{izi _:"c D߻LM8(+X7}L ;&lyoz!]Re`w.5H,|DB>xa32/MRVm=viMz!PN1Ȟ8 hj;tgF>lAqJ&oeLr~I~lj~ WpV \4|^dshk}=f̊_]-m?0bRF$ "u~(xb[yd3H{CRFwjoK71A $ZGX$[gmzǠivu!csn9vL!XY?6rV~&<C͸EIS{beUE]1Ə4g3NXbIZt>T?tbq=W0$%k*w"1ioJayi?Q_М 4;eiFIz$NI~71o->%?"R3H*>jOSK+'G%٠]VKj,t kح7`ޅeW酨[t%2@^>$Š{{!z73=qx_ >ͽ/Oy?ŵaUobt<>F_s:CY{~L1l4bXK4I'rNi<|_&lƊn]{X31x| @6bqc#6xogT*~z|"[%!H[ `\\P>n qv7^K+l}hZ'xD_3JO?u?A*M+3Ժ:or`t.'4! دJg &¤/stq.GhRΞTfo]Q_d!u[I׾jRþ4)\ՠ(UѲ-}?V;lIKbLM"<}kPʄ,,} c~1,k].;YS%:!*9ÎoD[tYDlrVfc,So+FaOڬR-ulHFEf!'voxQ_SU ;( _L*MQ_P`b $>3I ؁VnwHWdGn7"`.3r[kʢ6;{Z e+/98 4 Gb[Am*q]X8|pxVGL\oE HO! 1SR~OMR\.-5IR8S e=b2+F:qˈ#(Z7.ԏW=dfO'Y\&QGt TH=(P{E&C__q_fz4 \C ,g9ö/-2jjUXjU6##vpki=6>ŝu^@wnT{ }eUXT%;\:D EY5O7l>ߍk#2 QG{GМUMUyJՁ Q,9$pOG|.T*Τ8c~04|7(3sIX]~[MӦ4`׬u?x(@]rR묾Tew`B|  Z/'޸Z32MʶY}P:Acgm_bXѸjeeQjԓ+ϱM퐸c#ȊWfoZ!Rg0xl]GyCqfoLJdjZHƣS[HH7bsk\X絓D;e[> SA9Z:5 s_tiu6ao8vM;S.X0gVQWY 5o,5Ə kx,W0>M Pemd/1g1H޾;H3;+i HМy5q ƈfC$}$bs(~..#Radے!#ՐM,IRGH2Y ޿1r ]l 8o]DG( vb[Z[ *L{y;Ǒu*騨*%7A"IטֲDryB)> 'ay8/ aǩR0K<Ǫp1;RA|D?uEQo0w@*W!셚\`Ѓ* K/,pXlrǫINobdܬݯ5{gQo&5sw3;.g&$v!%36¥T[5~mHFq2i [XOD~" Fryo'o})^+5<ݵcɺfdpWBX߮~뺦3>/^,y_2>4ۿNt!*Ci so\AGI4?)4ʤ}C70^(̴^:8XU0ILLFX!UyA?uRъO^N|ӳ\ɜgDJM^#٩I@EKyBDoBt|3o MLx<O9c;jԴ'|@||/jA"Xb8%$Wh;⺄03F7auXV^ϖ_&Oy4tl}LѴ?) {6NHe7Cm7|K2~4`m e/5Yz>'+jiagr:,ogHۺ.첼!_{nJGJR䜈'D}uEUAL-AIȶ] $}͕T=v) 8P'](ZX[z)C ɘwNڟ  IN.yEލ0|{en&X#z5:SMle8iQPwm9[c;l$ji>ac[tcƩgĨ|!ޠM= Qpxp> stream xڍP]- ]K"wnBqCw(݊Kŭ\׿w2_v=MiEY('%qsظx9<~AYVu {Pj!v+fWP=2OsrX=~q?ݐ;q[8!oq, fkx.. |Pk0< ׉%~#~?} AvAN;_n/#? /H; ]n*hx_c  }if%f_~U-Iɶ;.:ð~MȺ˅dܕmYse{-(5n5v'&KSQiK|w v@hĐ.^@p'U_i4b~W{>ei:q% s$nl,^83J_rnp_VjsvғP"N=D[68UpmDdk?܍" 12G]5^Wh,# 9L"e(GZKLS4Bt&!]ÜW^ZEݝǶ. Rx{3)yH3;qV?ǚho#)"r7/u;[\dngaP#$FZ3Y0[x(ܷ]7J*B30ٶ9O -uJET'$cn]Sww(ZUFֻVθV9jAT5శ 29  s]O0.חAsm-Ɨ5i_;e3RlUI¡{SemL~Vw"h[ᲗVBFY+ 5"v֖[@ A.Xu0Ci8P;v‚'WmPu?N6)3BX&`NXb%H?x ьka2fDN2Q/ƃw >^R*9"R뎴89)p%ɞYC%`6Mh%Lv|%-)5ݏLt鹜gM獠;r&g|xS㮞4 $/XUi{Hĝc)I[O%DK-בv@s 셓)$´ Y0LT)W-qKZ 16}E,PS'zV3K\u9AY  eNAVXN;DM!lb̈́С[G"'߆XU{B!p 1 SmFiԑAy-9yɎClm)%z=kAn4?f톞N/ yVZq3e۳l:_Ivj^THgWeްnl 5N pBNmINb Γ[ĵ6sYQπ‘8:Frd㒦e D%^ފjd[W UQLK3@| R1Rh6%Cź@Y/B? ln -Hay4S>9DQ\!Ǖd:/nwe2qHMq[h{XEuk"$`k~H1fD(dI܀%}wn^^ă2jktьnfѮwvT&֫="0y &bE\丷菋jNgKPeӽ#+6'`i_ʹgHMޅ}幝.όr1KU2Tl3ǜ.'?e.gaVO[2*Գk^z1H"Jhz܃Yp\[,[Xj@FWNrsgj%+sIbcHx±O52HLLzԅ%dE9k}Nv]fH}m.|v9P#'TsQrxCeTۄy^Z +j.-%.#g}e]v{%Z' GJ5ҳ?U:n3׿.aRNGu~ZLķ El _]EmU&7x375`Fu~`|)6`932G }\ֵĪHy7Mw;,ҠL31wtDA2At;*b)?vϺyA٘70N#KBu(1x@*iF'9Qo%jwfHI<>D ]v?!-#Cn,AG)XbؤKtpBȤbM \)[-[ab/B?5za-Q:ԩZ~GHl^T }ۊnm?Nwҩ0l F'r&ĿwjkjrjX̘5JZ.8,TETyXl6goI _]-xM~c42ym2Ȭ$OЛ .Qje-m2՝nM9PmjR WuX C~O1/8OK"U5"!J֋ͥk>- HjSi=" II0phJLuU{G]cMpwSPzcڐZ>.ۊ*Zs*Y+uyQ_&OTgh{hs=!A EjǫaegJ6 }W?e;Q`[n\m8 pJZz3nP,u׮'TobxFPcm,sTAY Gp TIxY2>IbBp'U7Mo6>Cٟ&<`"7 #-`%m엤Ctt8Ѷ[ cH=l 7$Pw:Ѻ+3@|AGҴCbAWb٩cZ弌DǙzLLhC k9 W韠 E<ƚɪt [tcQ|q|R(UkHi:xeaZNmDŽRiS$';bL#߲0[ [0 tBGc c[X>>|ޣCw\#:_KD.fjXdJuϗWH1 >["2IxNQ'zpHܞ[{|:㟛 mHPt,v^YWAͫKygAܼ᥄H$ iВ!c(y~s|}c]_ })q\>j|b6,~{7Vz@{ -H@(0H~Be?U>S폛\$]161 IEp x9V^LYI_^^Bf1E奕 E%~o؎lGrԫdK{"뱴EwDlwO *Av#u~?d{N,|h@}n,j.BDӤĆFAUiØtNDO?__κ+NQ-/?V~q0TF4SJ:Su4h!3w*@0˹Ske b5egkN9;P׾Jg{r215j[p'+hb)hg}Z9"( в[j =}bz%3z7t!б,{MǣY g?Íh2kd!0aw =4Cg3ю]W'3_bZֽpoe;Xx/,u =?k2;h 0x6/(e |958}Ee#/cuXraa߃x>ijXp}|$9&d2Cg'.Zq<}ZC5cGD(:mMWNASMa!&K颥{1zD{*3e&g˿, GjRy-97vm$b3q)T/6&+zi`PzJI2v>?Wf|;?J2kiwIN먈U~BXWv̎oLs 55rC5DQyYjTNx6=Qːl.tگ>[״9K_NVQv`Ry%* HOR\^Ԇ98bƺ cC)J#0tVUشu$DX*iŖnȷȣrv>yFӁ] @<[#;A$wB/J^/"7zRz@0A%Q4\ Q|lϼH6c-ߖ5!nJe\+ddbg?&K[>DzX:~:9]@Vω.irf8eNV!mV->adDR1޾?|UHemC=A8rJ!UEw5-H˖ذ6T2 Oi c|q9flyg =NG|54+C8X:20&lDm+mէ8/It2gucGC)cF:hq~Á'}Zo?:?m~o&܏Rd[zgfwoeHFˇΔ>R%+. eq=7:sDn@1v9^Ipǔg[&#H1L[J bj+(0U8@'@vX3X.CFr2Q= _UвFcR.i%إ|PF CEˌ4ueD%)wj[*nX_$37F14WH+>ix ];ICv{ n35|eFN1A%U{-Ī Vb2_/kS]F^x+/M)֔ o4Q]&0vtڽѝMŇ'"] 69{Th7_ʬ)'8UUm/pa[td-5Jȵ zH ).Zů IEJ6*?-?DZo.FKMfCCj@ jÔ'}k9NQ!ӢO uBX=k:w.MkJX~z!#Ɂ§k~LV>GvIN8ЉgO|# מ ;y?WULg Aq` ݴ eO]*F+E5M# JҲ*rps"NRZW햱AFG0K9 zo,`VYJX﨓Jqq )$5_pAj3HSi*-wXc5ZHo-DfPJ?59X"@8C JLigDĕ;%_24 @>ް:oϛ8Si^kE51uYVɻ/GX/.}w]vn%]BnOvWN&OI +dׇ0eTb\oYhf- 9jj,>ؑ٥q } ;zGZ0|2<djNmhą 짌y$@qrR %>+ܳ|DwR:`٫ 2팘bKJUAFOaݼ|ݽ] 'J}Pr8ٝ-bR"b[{q!)\j1:MRN /*'ど XVsRy~*֔aZăcaWCv-u`mn9UKlUrg;*^]^&m9b`G/n+/wo^,~ \ZbZP<V:$\yqmo!7`V+N;@{*`Umެ3*:BUA%ʲ 99%í;-C{{0~j2)GĮfIU-V)Q оK?Y'3JŃ+Hƞcyz,$wh;GiK.OsI(@Ɗ7cOH6Cr;1)A;i LHwj  "izHe\#xGQip?[|S F(xeJkTaޘm.r[HR47'n,Y@|fRl E6ز<O`FCE!Fib[ :* s̡!˦5T{8mw|M̰c9n9¾-!> P@ԎR3_hg+_.3J={5+%R]rT ?++nBc~ BݸP^I gmX`8^`y3]kw](|=YK$>ЗFh1:|:vb˃8,$ʃPt뛮KA^-N]gNW),K2l <^db9 K{L9`f0DqMGɮ)zݢb}y\ղ}3荛a]˱:"Ka<[~grDk/xϭiendstream endobj 713 0 obj << /Filter /FlateDecode /Length1 1519 /Length2 8482 /Length3 0 /Length 9496 >> stream xڍT[6,"R݂twC0ВJKtt HIwt|9y5k=}ݛASKf VA\ n(@NM[q̺3//.>AE#.[!}V45 @ !Q  +[yBlje,sCk `aDD8d\pfphc Ё@`w@ \Eyx\ܹap{I6N`[ou+bܸ]_n ;!6`}  QRh% j n?pW@[\\= h(r#Nw; le}V-=ٹ!wnwoV[Ez2LR'3s9݆ZZM~,GכpgەšҕqrBk@iSfv!VDOkmTg!oZDsp=; 3ĪzR 8YE+DvNv~c ͜X`R!QfТh;D;5*o=F Ӈ<]iyê[fqgP%b߄x,u#~݂!q,kD <j`z9^)$%=p'J{x|rcQo[Hh0y^w%F% y;lZ FPen`1&Ž7`\ץ.GyYz3=PcbK3o6˥QK{[0RJ>\r+>A٣8ߎҚԤGBOnk׏jH]J `RF+MaB|+ѲCޘড়lJMjBA4(!˦DIu\Cvx7-Ri>]1a=.$9oQ Ե+{YMחdO?WUhg瓏kԽzp]QMY 84tt-dFuTK(kcm;$[QuoO>^G>_0^Hhns(~ NY`\[yqTOÅ"?!_1: m&mߴqRq,1ÎG\=^[P#e mتxrͯ=_Qj’Gm|ĝtbWMK7,| };(!I |"ژ{"2thgm X J>l~~oLv PD Ot }zq‡^ >~EkXɤN R㓮X w}yۅ^ƍߺ;Է|Gc &4>u,>) E%C*ʙXenNo9v B؅-{ʛ'<5w2_T~.*^Lg(fAģ$l7mP&Gi975݁L$ϲvc?6%Ø!ۤ]aNONf_F%FMI=ghavַ޵i-G ޙ̓3^K` Gn]R%v4Xp\`5(ށ|z̟gԚ񁱔gߚsmtsm'5sw}U?>׹j^آCq)[ڝk `IIԧ~cPX؏öy>BBirm,g(u5_J?xv&.9B':j 2I 2T!؜t"0ad䛏.qLջ4_E~h)+ 1AAOG1oEW£Aq$ztb'ia?x:+Q)uʁ5|IT/vۮɀx"bn&5Y.)~ATǃˌҗ.Uצl9ڶPz)c3}FCKH'sEțBSu y>KU ( Σ6+lfDuA&XX;qPz!$3_vJws ̚ k_K{h11#YxD$;x6oBm `\ esY{KUVzƫrbgO1% [^L_Z\Ol~#@ B_.8Ւ^Ex'uE 4} %x< 1خA>% DCCK~j cYÃ#@EuWeoz>nԁ e=a ?Ψ0y nRL$."i~HOC0k)gN<=wjťmΗNl{VAp]Eh>: n2 ڜ&e%ϭ\l69ͳ^?eڢGdCOvuVQC:IyBz=,4%/;d|uy;/Xk7I`u:9=ԝԠq׋.^c!@Armt,"X9WA]AEJО^Τ##1`{lacuc$)dY~VyE J6賅4s_Kd&a¾޴Gy@V*B9 LsoA Ӆx|p~qUxRsI$Vx$4PcX(zm&5+$Յ]ҤRQdÆZlYk 볼!倯aHKkh`QDeR N".m L:4_!A'dg`v'%rUY໩$"K *-jQ*?4+cAP. X=`>9hҨٳv7!-iפ?$`97S\c0,K':,)iNٌ* IM73؋]Mtֻ?[fΥ5z5y>KJĊP;Nz-Cq6C+Sj!JGBwL"_2UI5<p/|'ٻ:>a S{C }-KX]%L+Һ٣4 VOgՈ~,Ť^+k..WGTV)]ңBC$LQ?OJ̟PJG$Fӗ ?Lrao](^h+))\QJ KPHa("d%ɶг>Hwk&\uhWsI]o~Qm e?6t~_\ưuBPҠ&|Y[Kܱ]̙n~OyS>7a.P>OjfrJ1>)qs9i&awk`C; xݼl ~^r@XMu9&Oz }O%!MsXoiM _zB,0+dDl]Ϻv@svw\!=oc;Z;xJE(>.Z0..=kH[U(!H:a\M;*֫Gw6=_fG&*~㬷*JW 32!D]P~G¬Vw춰+^ɳXP߲>:KSOV},rJ`S|Dz;}ȗP$XՋ_se2jfL9?A :#\IW:X`uvt& #)+J;a'&jJ_]|*3z;;=?>Z7 sL*~Qt EkJcON.?7LD:[hk1e(uR Ψi5FX$^mO_6iZu 9i#2ˢY̬Q}6?Kh JSOgqٗYV,In?p+,/c\_IriMc1M >6;nK*{i/|My٥v}.PuxIz>@^DRM,@Pҵ2#fjk[wx4Z"PᏵ_=sIc~Vo)v/B#JBeAر |> ZS 4TeFnB6(vsrE x?S~ۡ.@%1kcz}Z[M?ESGÑ1y zq*f?w6(8$?Y |;py4J˺T~ AF5Dlټ2jb:&<0] \%gŠB\HA^y.j=ڸMk=Ial6|cɊx@ taV]m*<<38-ƽlS`Y8#%=oJC2)tLӯqyn(EgOK0~BUݿʺ}1sJ5F퇞@Z)N]u1?tTg 6f>rUh/5u78Vt,)kE xh(ph5\I{uٌZߩ=ȯj2N}?s-ت!Q^e!V ^w5&.a%kIcAlB3`ڂL*B3&v~ni;Ƨ;ʤIЄW/nQiJEn'];,&>EմX7g z92P!]GUBmPߐd^o /z.7 8L SӮun;PElJ `UYI6.Ɂ=)]DUvĈSsRZ._DIo⏇ ϵ8Oc.>xg52s[r8yhOĵ< Q;>`팕L+K^^꽗N6Qs':DJw W LNpbrQHDśvgX,gQ_w%:&5;-BqպbmE+Oi'%r?"6aPGF.K"7S/V^0)2^.!&rZgO߷!'Nf 9}_)$}/^Lց-="G#$:_t w?Ų 5.,_rw.Nhp})|[΅_CԠ· ?n+yO3^8}~>)\uIȰCviSs* [v½"!aLU"|gacK m֢]s 1 &W3糀0 #X[}N ·R8Wa ضT 7 ֽwf]f (^f=㩤vGoV[SpoShq(7%švW2Uk.@s/$7}McⳌIae<~km4z!נ2a8=R1o9C^~ vb\f[]`Mz^\ԗwBϣϏyH¸16٢"@mU"Dڀ!cZ B$6EYld7@fY #:3?o 뢚fs!? ;(֢xԿ#Ͼnh CL9F wd_yڒ׺45qzț 7:ߨkK.a31A:t|} ǘԌ]*ɒ9ꥢ푥b#Bqm,-L&hi%Ep]]$V51߷ZC ӷ z(Ou ӷd0?x\+;Sk\RTPWLT_x4NIn PAIc`O;cxd'i:\wGV0C@b| |x Nt?U}#a<0/sbҠ . ss!VM`Va7f?jD-<9Cp5  7!f3AKyY+$)"{Iqe]!BIfHqAӐ+N24E_ȅ_G`–"MZP낓8MQMٺqӔ;֩d5IGfL)zoyw߾bURktSK拵/A'  LhLt֛IĆ(rDFYȄP_HEmR ΅ImlH9zr}@MϦpxNz?QIܧQx%g_Q xt51c >#$ TzBi$c^w]HcLN8dszz z-ոÜHʙjM_=o.\[N)oB۽~]]Wj:\oqʰP@&t Rg$cq!x!կiӱҋˌ )GE;['ܴ:)^w1myHw?϶ȘGs~DyAAkn0?j1dZ2EʞDຨR^I I/FK<=}匜KwZ2)|D}$UXB0G0ƒ{—a$9%\,}6]Zm@3 YzJ\ .9%-EX鬼KY0ςa9=LAQYs/aEvXĝ)pxuHt+ͭuc'n-HA:,nX:M9o+;ꆑDR.Y?gZ^LGp\!6QsT>Hk˹rITG_f8Iu*ڂSAVq="(M1xqDɧ˺&F< 3*"2>YVlP B${ɐOcZ8Bs!_J^`x7Eпȭ4P{ӞE_ հa fKQ#o"sR~zջTl5F-3=_6#EmdI¬r2z |O0 #1U2~{9Pӑ}e.tTvf2{VZs_rC^`Mb-!mHH l?в4}e xDE r!t22fnrGr  M+0vYڜ`7sCp?w`*uAj Q ]柢LL:A"8;!C0x{\0HEczn_SV ))͗I o|KG{y#> stream x]~(XIZ.|qbh|E%R!/3;lN/~ ggfcwﻳO..ȓRIz+/4Dzfs)]׍6vEB_\f"r?^a_J7v{Kݶv&YFMu~ ;H5k/;B;؁`bX0s1 3)Xvi5d*-9_htWt)u;Rʁ @" ȱ7yeV"rޜ@<7 *N`HOhe`<@\sR6E7R^,q(Q굝Shj̒]h^.Q :3^3uuB6a NȗwyMEi1<,w[FD6CS) PDy:O ȸf(ϐӻ4+v$#1pK(- /qH74nxI+Tٙt _sSPց.ZčF%aj(:V$i*IDȲ:QXKDj`#rn<{1mK|O'B՚('in;/Ir԰? to?|8VZ:6Q_V8ѸF kӚ9iH|XpפQ KS ݝ 3VXs^q4=]L28e;|.ȸ ִ4>$lH] xaIwT"4"XJqݼ!kSNS5n%7Q NONآYcaW$${O4I{1 2G~m%bP-9{cӒݰ%JA_5sM[ZOBfrVU2 (1D=%4%Rrbuvr(1\U`:7mi(,7ESptJ8#-P(\PJ0 pPb]:&ZVs"P8@:(#(Y 8 މa0@>PzY*^a/ rw1{ ȁ;F"Y6vP+vѢ9T{^O h!6ZC;R)@]-PW>ժφDMQnSm7{=fET왱G.QM,ؠ88WʔpHhgXYXG!s8C 2>=mU1mˊz5p\~Iպ<$o6c?/ٮ^ڶ[>maѻ~u}e:^“}~㭜-7~Ro|)O};?T/IZ(nKj"/Q:xPPӴcH;nUgJ s^$C'2ڜ/(??e?]3\R%BUbtadgit*pKhBQg f夿6,Eq>Na6-su<*)Aeѫq8.4MS`<yLYT#0e^Tˋ FO=^&L]T*3q%[qzӏaPRJ";pp*&1aoEmKmz1ZR*yǚKqHZx^1L5ăԡMŅƉf8I`4t B[PWVBk*aC8|h6Y!V? C9@撮_FD&iQ’ '5‘>ibM(@EY[s .^"/bp%ЛÙ[M xĉL q/I) >87<ҏ>bA.*Uԙ4?}&endstream endobj 715 0 obj << /Filter /FlateDecode /Length 2859 >> stream xZs6_IP|=$si5ė\ZlR],(2"[N:s/&Xow̳gߝg<Y3$櫳7xgهʴTlWg>{~qͷ>+Xa.YaX|fҊb>Ϭ"Gϻz^\.9Μ4LM/+/][mq3:^mvQv6o}`txkr~.}~3/E\ꮪv^}B[UO^m+flZvcȪMS-s@:mEde^Q[nUT5gٜy]exY&HE P0:^m4ok ZVUf7$ڵK.-f`;B3gD6Ӛ(F=YgE&oQW[ybrMhO;%sˤdga jb[%1 sAp 1ՄSւ)+Jf v`BC$&i^ vPݍce$sdX&#,8Lٍ3Q 3 n V;X OlEM$v^Te|]$!*gx&gBH7(nY&لg&R&g=lg\!M <0復O"Jߛ*l)fEsa,"kNۊt>ƃJ ( QL#GP~{6`Od?.F6H f?0FjNf,\1 |R&CV炻Qɑ4Eſ X8<0P}2"G h( a$mO.oQÍũ]ϴtrQ#}եѰpEx1O4Kj%I?UKKW\B"5$2 )ȃdI#ЈHBP|BCi)>AWW>^AM}`i',lf?ɨ]}ÑL|W^.O /X.Hei t{H*.ށt;@9y&"9l$Hrb;ovpًɬU76/%^(CIgCI9M5kWDOl >c}RȟW[lpeW W0ĪnpLeKjȗv%@s_t^Nq G|wծ);0* ΠR(U5/1aZ5rn=bqCnC5 [`nJkoݗO.۫K Uw6z7]zNq@:j8hmӖcY ~X~KWʮ6zُ#@sX]~q*v8\Hq}b#3Gz[瞯WߧEJ(_W_N?Ʃ`r4_)ppr`[.Z)lUDCGV(a`#ZbXF q W}w_ ah`[6LttM]L1u;Heӌ@]wYa\#kHlq3(b=)'oT9}]}6 UEH!-8,l벩,qz{b'P(vINGfAc07f5b7YJbvq=yޫlܘ7vS$+I?8=1tzMWAal:@$%FxYUz$mOYt)g.&bfj-r`AJݐ(Pjѝ nb9N6D)p'?g48S0ekoz{ O%|v0ϔu |uٕs Ɂ쯠b~&gP15I*)PSP Aq<$gމ)B!M,S BR0pwM\b.X-ߠ{(> stream xZrF}W ȦJb;뤒E$@K QVT^j_ݧOjn?~L;Q*Rge;%g;юqXicH{*}gyF4NE*:wLu>/\6y/ڄeh/5{{u^CVNH95Fa(/7<_Pc$EwaRAJFIDr%"k|izuϪ_y+/Ru4A{?|m_>'6y7JNt,r[ۢ*?C{/PVY46M%eQ .ysl?5?T)DC#CYv/o[i\K:k//*L"uB[,-;cܰ4鬝sOgC\LCa %f^"ouqMw,j#Zߑ@UM2kZLlGǺv#$Y}if!ꕬ.+™Y0v"*<F3vȺ -;iWEY@w:VZ ΀\$i^\lbY4rUS{ZՐ{8Tm; 6 xAY)~(4oQqpz8@@PҒcCUU68 p_T5C|fv, `m'W%Y}YCWU]|W/YQ6#vkݥSϭrQm2B4(Urɴ3 `94w< v9|o PP(o[ͦ8fNEڋSBf251uO8( lrҳWt7Iǜnn*DeŨpk>;.=;c㹯[&C MlFm%}~MS DG jpM.>NPl5K㡓t3 Ԍwi5U aZDEC>BwAj[w /p^7N9B7a+gҞ! B6R _Aࠠ9-%O]9Bx)!sxt[=i^ץ3`1-o=F+o6c;I?ACq 5 C7!wv'8Z#z!zA20#}ks70*1S M6W܆R py!\oOdbW`g'A_IC:>"WG/qA( *ۦ[+newe7}+HȰޮ>+ZvFަ_b=Ǵ&ɡ8s\epk)y:{Oz<$,lbHptih;kixXFhpNShۧϻULhQڇӛ mPPЧml1 ȓz*1vjkmr3F]~Xl)3:@C'-@k|9cqh7jv>J٬kک]s9{~LnuT'#`L5so2Ғ o+j\H;ZXI zQnK -;Q9aS/CT;%|q-î 4=4r|Ǔ*M:~5endstream endobj 717 0 obj << /Filter /FlateDecode /Length 2199 >> stream x˒6>_*# ևe*Y'i$)R!)ۓn4&˥aF@F?tX//œBX]jeE9o]ֵY0_p۪Z6.U\䅴"n{k%2g6_殄uVpw Hu5H7,o8_Ul5ƕA+wMT)M3s~0'd B}Cl8u.- 2!>|WbC!goK};(8-H2eU뷴jk/ A$,sEy\I:iLߖ{,6vϹfKᨍh&H"q;)AwU Vp6H'^7Y2nƲ<FdMn[Yl-F|/p]>C+|:(Qx̖З-RSҩ=6}i|kfQl _8 oo܏G# U# 8^UZJYݗ$>!Fblvw7䎠`|=*@nG38U18r,_^Xui0(m%Ź \$[Ht[[ -hxh%nxO@퐀Fv9mi`c]fo\3D4MD"rV@JB2υ *kuOͧqyNP8)^ uŇ;ei4?H4r‡4ID oMm 쉴xfi'(dAӱ ^j_ffc~ =+խ  Z"/FپT m݌ΆmfkjS^/;wj4euFhjfCRTY =8g``r'gk G$ƴ3Abߵ8S+F3h.)'N}$BOϑi0"4GIcPO`?0C7@5`X6C_Ql*(La$3etms 5;xJK\EH[Lj 7Tx]Jj17GJоݣ6>6nZt}l ][UvrӤRŎTQa8&J(tF*%qdBJK8i?Z[),C焮UXXn70xYFC]Q VPuψ;CUԃ:MBܕW=,"8n"$îKivkmT(w= udZǺbfPURcD'j¬}&xu;|]?dz^!飵,s bp*+7]C6P#7j[8h0+X^.-cD f!0t6ִwTyw2`n, ٧c)}nh- ]=K6ݴ=tULpD/Fﻹ)vkaߘh% d+4 u|p*~z\x9WӈI>mi2oҸoi@_qKs<{rTT `M~oi],>"{sV߰$_ܟ܌.G/L{ؚޕXQG7Jrly훥FSN} ac#9m2N'錩iqk/б4?'5'ghDFF InU8U,TlYLי5>]>'?qn噳`S= wyv4ǯӎKi>E2h/vߏ$ "yP 1#>J'8NLde^RH5΁³IE_M'#V$Z/4J:Sǻ]~ &Gs}r7gnc׉DsG_]΅endstream endobj 718 0 obj << /Filter /FlateDecode /Length 1992 >> stream xYs6viA/uؙęf<l(BÎv$k+4/"X.o!,pG_|y )2(Hd̂{,`ǀ3c]"~ώ{bgL9$2b2"x>Led*$5Bc.Dzǣg̒E ̒L`OȬYU6Ih&ЌY'Sq"a")ךn8Y3 "7YW27'F\؟P͸M!^d$Q2Q5N_Ii?7kލ'y7b"ȨI|V{T .x:j.Op [jba}/ s5a?: qvמٷRXKe+S6o [|%]lEJʥr0>{T@3$:+β`bBvDx 5rkp0~Ġthh2n%k s]b# /&Z5D|6do"yc.fD]mtExdEYvM[ﻤ /jE FC58B07L 1xxlLߵYF%".5;o,"k4-, %^tix5bUGG5-MU_-_qyC|]ɅxL\% s_P zbؗ;=EavD4vHFъE#c3ty v:z&"( E͝a0 macNIX|p]k_l :Òy uW6Mf_MjO 羾CQ/ o{vK.&o\4wl⥩=V͠bаE"X:+ޜ[s@ weh5IRn#(ʒh*m[6Z?yF;-CsCl8 ^t_ u^Dk!tTuWыJcyJ)9iܵp0Lz8Ud׾ Z[1|jf*j[0;^/9o9lSmZPWmպbcL6A4W ˜um[;EoOhʥsDfڱs%qv~<|ReZ 1?|zrl7rRu;NӮ$73ucyS拭J4XEm|<2ym|l=Ocp>Fu1m7!&Į tV"fg?yKEwIk՝O?әtSs1"M 96muz{rE>l0*efm*qVwrvɶLSC*%{Dž٣*]Pb <բ}_jKWf12z4H,PD]Mtendstream endobj 719 0 obj << /Filter /FlateDecode /Length 1725 >> stream xYKsF WpP3O><:mI&^(r)DKaY~t8.X R̛y{~gRz›^¼HȀڛީ/>s.\*3Hj9z?H$HBZy8bFR)fb@HrW~I(A*?7EFh3HYݔ|Az.ulpIaoijzY7 $8б|I/Ҭ]Nv6S_G" eiUvG,J{O3Moiyw'o#62{q0νP`+bO@1xRvF'wv@ a>yF0@ D((5$dGH.s|NXc*\'iw{tRK|&;>iHF7ٝ\\H;+60}6NM_ ~5Vr*mWXD)o,T iNh]3˜eў>+ 1q!0Mha5&'Ԃtڊͱnuϟv;+zq!5YXXKCԪtU[`eND/ 56nn.8$mm 6kX)O^gn5I^q[nl$"H~:هSzǸhi}fC0 B!z} <Ԝ QQ]]#2 ioHW~qY]`K!YHpb1(Roq}L 9ChK;f].urߺ 8{U)ͧ[{>2D?1weVlaׄf#Nu)\6\)P DŽmh4vl"i[Rd\ĉtOCO8^b iϪB; v(=KZ1]Z*wL;kQq&bai`谄r'ImS$rk+(Pq|s5vo{[fhjtߍN:m2YفH@'m4'hmX⭈PA5H7b|}sƗ`kUOpoVO+)O.mfJ`)?MeuPF#*0Eeaf`.FqL~kWبk \uV@Q] ;TsiU]P靖3GH?{,9}rH.}I?q ):Gȷu=d@Q;E8/_4Z-h@:!|`,Ev_;8J?WNendstream endobj 720 0 obj << /Filter /FlateDecode /Length 1803 >> stream xZ_o6ϧ!EavZE>}Pl:*K.)%>d{ln0W &V}B &gS.>yA?BTM73If#_7hbs+!Ȏ9n㔅ϕ:/GXx֡oqXPWIiv'iF$0| UD4dfu몰,Ё\_`T<EHfwQ ,e|(y {O0^ޮu* F=jfjNp&[ZhtՎ?\ oT' 1Z~Q`2UnamL  Oa-Bs4QeՈ;$L!Iܝov1q/P3퐢gvGԩvuSjOLQQ&'t i܀W:mEg>Yl|Bd4 ]\vG{a&mhk_޻ kvyObǛb4{3<{#}K,8IDj)XCqAơHUqa? 9cC˓S%I^ʹЀ%L{:bZD5.oɹ9,y/@j90o F5hZqE -o"a7Q y?s-Ruke\N",߬( /:]f)Iӂ'8fsM9MbkS {yhT 9`+@Q+W74T2Pʌ$Y?`_*\endstream endobj 721 0 obj << /Filter /FlateDecode /Length 1718 >> stream xYYoF~ >PryCEӦh~ȕEXi_ߙ]l'*2pٙO.~`YncˉkbIXO> I\[q\-?[Yy$-O #_ڋO$]O"f˴nnCV*ȇ|\F"84ثwtuڭrXW|=c^!>݇᯾ ๮>xHx_^ibce1O;B>p6'd]R4)F$DL8yҬ)VGľ]JtjHg !p?C"13]C_D_WIlU)Ӧ*S| 4 5MNIZ 5M61=MggtI#flEVU mQX1utNJ&JD)*Qb0p]p?$v IB$A5D$^I3ahd"څ_YWF qXwHvc*|OD瑮EBm몞Ft,zAbL'.4D+dZ3_ehbyHm c A|*\# ^)#&BX$gPQd`A b#PgHG}k(E+~|d\#1b8X!maBkEZWKX1`Z2MI(!~W䲦Urd TYz wTi^K8XM]nlB桗zháU"T`\oPz, }C@ p+z_ejs]_(|gh["m+JKT|\qܱ.g>x"|IY[U "Dcn _9Jt3xeI 783j/>o^ ON4CS,ͲW5oxnz c}}n+(-endstream endobj 722 0 obj << /Filter /FlateDecode /Length 1477 >> stream xZKs6Wp 5'L;3mG@ņ 'AYbmD`j,X>Q=o4eɃBq{O;f=aB0(t= #qμFz<ܧvD#]T?+Ai Boy1"#Bz~*&o췝&\n>Al}~!7A1vIM<*N@c3YBJiiSewuLn6BC#aoR_j.j Y\ɭ7u45Wѣ kgvq袰wfb`DDd'8[J~NC(S2 mmuZi۾re[ %" ?`}v7-i&?xd5 ZUz[2qNޖAT4FA1QҘ(b$媐O!3@ +/ƬXC]5uiΤSM U\JZU抧Xs#=ma#=牉Va "&|u.a-bGpءR 8ڇ&@ Gfݳ'H}:::pӾM͔ݛ,o7߳7䢵:"QYL=E@[ }6b^q@uOFʴWҺU7 "rҔ"'٘edaX`1'QiڤZ8̟e]h:r1<_( F^`kA敃 =OY^(2ܔpEJPV:|,dv )pU/νy9 p89(IEmtendstream endobj 723 0 obj << /Filter /FlateDecode /Length 2441 >> stream xkoܸ-UDRø+л&Ƶ!Y˵hTvW&1C +r8 C P?_~3/ XB/&c]-o6Wʆ/C7ܤϫ-aoW__M Jfխc iD\9:: "eF/y1өyf߸<A]pC[Jsس9 7]W^UAix} UT m)Ŀ#͒2/zpʿ _Zҡy`/ye1=9߶׃m:Pɶs~˾K]:mu^{F[=Kę:gV-TD__-KQZm9y=pm$ h3ps#YDTe9mĨT34vRz?Z߯办;/[TO}/a5X/ko:`[x_9@uiB8}~tDλ{ W2Dr$M-g W[N.NOe5$?)4 3ww'rX 5WqCʭ}'Wˤ(FpѱiX+Je>$2 Nj0,ƝÅ\DZ.l(:8޵t:\A^<\=t]V/{R:6a$ nm?[ r̫2χ1պju5cX-q9TzKe2h=o9ۇX)H8͏"anC-#UJE>ry-|)7'3* Tg ģؿq5jUC]K,4~=ǣ)YL1& Eקq )4pϨ0Бr_+.1偫R7z84L coX>AXuٗy%]mad롄tp,`SUE_o_+ՉǂR|D ߜt+rJl+B!{c'k0'dum ǽe-dF-Lʆul19<иk;u^+M $[fL3PG $^$ H.0S0C5wS:?)`Q1˦-'M_HdҵQ;غMq2ѻWo၊:;qУq}epq5*Pv%FNVH\,c˼ݡըL]e;#K\/i~I0k r|P~=e*򁕙 :/endstream endobj 724 0 obj << /Filter /FlateDecode /Length 2282 >> stream xko8PX`qp]$=$w"ѱPYr%9 IɲMd953G3$.=꽜P|1<=IaڕmҶj OPƀC73@mDyOCH X.ĶdF86; A.\[(K+[mmQQLw͔!3?Pr-0MV,n49 aZ1P"dy[ۇ~* 2P"oEy<|ĩǼ$&/ÐIe %O J"|VI#%EqfCm1ai`p&A,+fi/StN/P,&.i_Kot[߃;f'M/r~iACۗu8@(!J*W.rÒo0vdf`Kpq*yS8Ԍ@;.kbɹ3{G 8̺{l gy#nZ]U:]mK>~=ڗZo,,8=`eB$JdYxj6ݢZh T bJc4&tiЊpN%۠AT8,.#>%$7866zS0jyƣľ B9FnjAVG~M^pƞ$P m֐%0S E؈M^DT,D=Yo^l#]hb=??ĠR4kf{ZWDh>30`CGn lq_(V<:6?;z zny F֬" aAj vyyux"nfZv?ඝL*Ӫoe#,@(JiI@F$Vj]ؐZe۠JK %GOaa\0}ܬ(Ӌ⵵ҥF F i*c6ƺ&-,ͭ:!lxt] %YWU>I!̅pٗ~rdF[ EimK޹`X.b$ĝsKApa;q1[Ddz +?endstream endobj 725 0 obj << /Filter /FlateDecode /Length1 2471 /Length2 11781 /Length3 0 /Length 13197 >> stream xڍT 2twwwt8C "!ݒ) -o{k<콟 j { 3; @RY^K ƁJMvwJ rrCPt]2) TSPpsyyll*; n`s2 @rFwt[Z@32e9̀2 de44 qA'd sfwg] g;i on,-+'.@'* PW9 h+T@V`S;  hffox! -*B+m@7 h U+v @F\OfN`gg$YYb.iog8O 2ޓ@!A 0w"!`GW?JPfcc 3+ZYz;;,| Tog *;;l0Y!Oޡb:N`tld2s{_]fTїQf7N%$=PVfNN?n+%U  {9@on?C_{DtO `fy 27/ I/4v`[T#]e{@V]塚 &K3sq-;ˀ=@j`3&n@)l35bc?g3^/ОuJC/!7De77t jk,{ / wgyE#^J=!~ *O*8OʧxJOʮ*!>(?!(i>!.~BP>? ALf6 Kb$Ow-%\\%vvOjR9BI4 ۓc{W? *O疿3П*аV C* BkhgТ=Ajgz?u}o8t u} %.#.hЛC_|Vǧl_J࿶Z?M!brC՝oAl t4'b5bЄ]0pB;&9@{? ^OA=y+ Z[ /K2C]^7 j'vgޞy}Jƅm ׫B`SJ̕{ŗ)6f%Re K,n/'NtR/"vB7CAr)yf=*g{ xNTlߪ }b~\iVAy ve֛~ tnO!.ugz]VbL9L#7Jqo))Zy*灕wvEѱ|gq$o0. 9K!8 Tj{39XK}*\?|ez&SLOվ7++W;9i>,-J^F7(ݓCdҡ&t!Lpl4EfE>-U 2?X;cM|Wb7 ڱˋ~r DFH"ǔ؝ǚ\(v0UNlGTg& ox䭩J#X}:i!lԜ kjn( Hx2MZsQ X= ;Bȥe@ 6Yqm{ecc, #jn~ypqf&{ qzg)3ruyei>}}K.f:X 7U7N+z!w"D3l<G8I-629AʪWz_M|&\HƏɾEF,<(>8vG'3Ph*xlɉx٬t=⊟%.9,D?RioV(DZtq .NdN|Vx#x9ös yc#>/sX!QXȻz{f8A+m,@Lcԙ&&Tr6#Z$G Kפ(^2,I[$>ͤ]ViK+#+:|*x|n3V{'6qM! ?1YGti&3KЎJ .EIeP>a2VgdbZv%*@/-.ݯ4@n<%Ӌۜz5U&)x  BY{\y]>7&[ufDw~i3+rWZQU/0{n~eȣx_Yk/]QyN5 !bc8dkd$A;Go⪘r#ۡG ӑ23(|Le\3Eh+v LீV @WؼxV1C&y- '7NB`>t}1:cO¥e-I7=6bBԠ6``8 Q;/c;&0>0Bp' Y4L~TM' t W%_zOjkD/A|ӦZ/5%{;9~}F0غ<1y%s$|~k/ZXqUvԋ]@,C0XgV9sn&Xx$4h qt7TXiGk4%펱]O dVQd%"}⻟]TN70bǃ.cŒ,VW3C;03P;UiW(P󪼽^fO2 o'Fw;Z5+̈́( F=C 9|YCn#DMi<ϓ? _%R~L8,ayH{3cfXCKP&Lo2N-Q"!̢ۥYW! r[9-ʩMJѻ y v^%;&mmDg/J*8ɦύU<\c 2qeZ&sl%Ig Ut[DGEvD\% u'SpS;Jܾ@x^al6|U6R=>Rk𞥈4{$tt}ʺ&/ZYVl~ >xlau0,/.!#RIĎ>Ů޻7C5o}g4>9Ԯ5-m1kfr :(9`7Aer U ,X|Bs/Yң1 s}2ox7AQ1ujT ]fs4pv:^OUSh{~4@ $_@H4,GFȧ+KL;V|xب^r, (D*̩GZo+*`c7^om`$}[*Jje?ߙM~^G^ޗmL{p%y);RS*exbzPhtsXZvsz {Gm) S,R[9,bV. )FBsf1ur%߂5V82Ys>4I}e5' 4U؆rR0a|A>{7G{;U<%\7>rZ'O H~&HPbzx")y5#;P"{on{wsϽ~2ߞ?}-.H1zqCw E&Z9W lJ6ctS0n GVT &YHܥ89/ĆXCVڻo?>V ϤH~UiuV t-ňQh4u¸(Td:Q[x -׺ܧHO'_o+,"Ed] <.I\rVץ])ChKS$F#G_I Sg%!Kۭf#hȹ Ie+&2kʼnbZhx!Txc|%fI@zK@ d@.צ'FYdEQ"E2%I慍|ԩ<%V gioǡY"^-eu6br` w2R~$b:5>ĨћO? dօM ^K]qM޸b*6ŖS>e$Y7SmC*0Ph@qD`Voe&cKٝUe ڦLz|3*%BX<_wem6cpW贾ױ`+Vi%o8]/-`jX{xbPQ˾ʰnx]uZ3r܆ejUUrVȀ颛rGסH>4~^x'HUSVB3B$LU6 uӊkNI!Zwt{fh2osA9.M#%^n,xk8D٥Jr(ATs,n029kGmNgWЋ8 Q iqMC[r |mwD{$C[< LjbHS#)";BKؘx߸0]>r@3eEtmP\frx+Zf&maG# ]1haƨ:ޞ)ڢfK9ھ2my=&ih/!IU6nf=ajf'uhR4js;G$EذW Qsp{QMxtq(j$GIQV ,1Z58+@=mfYy#DTe>*V / ?_I &\'" R{$ɏ~Ma+Y4 'ֻ։X*WgSJ6Yxl(}"JӪQn( l< 2ztNq;U8V2#Gج9Fc'OChǶ /A_c?/M܋vz;P)rc\jd͔n4h:Oq߻ռg+t>I:VZD,V)E0 ݄gѦ;zHfo{߭R,baȵ~ߗ}Z> 3Z0ZҥRaxͮʸLRy3ƀHײh+ Nw._9wOb n$'۰W>ѫ}~w!(T6KLu~*$On{$.)#͚mPt4n%|*78W86^ƇȠƪCM)ʥnT%ųUp$PCĀ8# b 8o$J~)MЋOMsw)cX#@Ɲ!3-"Ii~@42g00]ÅprOQr^B}8gz/<ͩ~,\2;TD}}ZxtBxN+U pӎ,8\I92}k64%y! QU ? 62|K.>``/KIQ/|w;v+#$HgaG.fb ŗSţ{Xt֤ZV}|~~wfRYhe"iz Fqk9rO)57R%Ra8 VZL,<1tfFja+ nR #X_L_-*ltV)QFQĎɧ>?KʍMUލTSth)ʱbo8MuPc'(Sz/vJ4&Vy DuR:TXU+\8.t)21*LRG`FcTkLBJ ˮO~BԃKmՋ+y4/DF҉?'#5[*+N.vbFz6Yhew|XЊ ُb<lk#+JzѢ6˲q]͵Zd0F6wu.&37CBMWi8#k.o-jorBG5) ]7op8M貄a| ?nՉ2_CTg}x= [0PKؖ7>=SN fз#Xs8O1[8EtrydAn iHsu.ȄUD鏑QD_lIFߌ>DvYKsB+sϾ.nhf`ԏ \ PU3Qyk ih@fc*k8QΤ%<ᴌ3=@ʰ5I\-$h'z24 oyF+_6/H bӧTK7q.M/Uk 2  4؊blK8>7Rrm~V $gnٔZ#*6??._QfﵞP>v2 !*\o9,p :#^E\G(l.щ'5tYRbHd77r/ǜIi],dWƆXT|ۮ]oòr˭ǀr_44wR_x^Rx|۩hIGd[>=DvPpN-ۣ|>(sY"EKH |[c+'z&^bܦJOQxTLT~%wH!" r$2-rO\m΄p(O9&kՠƱ dwu|Wad9x_]3wHu~iE$O``f w!@WT!He4-'=Ne[JVLJEj Rj ݶd3V|b#`0M?8v!!FG? j \)8-kgR|y3F耱-L AҞjT^WtZbuDiî _k_ 1^ePw\TyY+^B?/( +duMpAqEҖTe;*6LkJ#]6:ud9ЌgR$[!0ŜKJ"f:hC 3FH&z?eUQ@IֈuV/Ůܑ̹GxwI 8s(3cp\uT=^mɔH*uGsJhP#͘\c_vjt̷P~L!8P6Άp룟{o4v}o+Set_zktOh˔ZpL >$,qOMս $`HGy$rr\u}4wpG4x%sej> ⑁I@wi{JơU~|\DYiVj/,cw%֧ǹ#}\?GӍ4>wRÑ9éEmqm:8ohYzcqѓW V&bγRÎz |]{S⋡ehi='*ћ m$0݉H}wZ_>;_ջZބs؎6mܘʅ^AB#C+r_g"~D Y<25lŀYbnN”Iz҅＠!,%$(ĸV,sVM[vFog׼aShS?Zd+LDZ{\}ZB@\r25WTb6E^x6Ծ)~<m` ,2qNpa\D70hH]<7P{laں+s-1LĠq2<%7Nq>Ǿ*D敞BYW LKag$] w_b)uL.nn,40 !͹H.?Kg S hP8أ[/ ^DO[ }dzSo+O}hܻπ}s M?t8"rY Ɨl"l2|8.Jdxi3etf 4sܟH`m׳=;zA UoO|5.*n*P͸fi#e*|30M'L؜H% 4ϯ &7әj׽Vf, _0$z'Ob`!e\:@ \v D" <`YP%2aWdzL(t>I#$IB>i݈E7/ce͵3MTemT>er0Q>9?u"k`u`P=?;[X;`"(3~eƅw_3xNX]z?)EYK_x$n.W'Dj%IM|vk;y͇:Fӹ0[n4ጰ5X+ۮr$yZP K-@MxXNe H/[\57qg !cR%q,):͐.XDfsDD9 L4$]1q bTa Gɕ۾OWhm [70Sِ=.o:D̍b3~?@Pc&tp :Mh}-J[Ǿ* B>YR@`yъjObSn}~թ(VK& x#e =sk+ΜRĬ3X B/jݱGeN"bJ ̊Femtu)]Ҕf ٌFqAؚ/a«sus"wb%;yT x<Q)ž/das㎾7ch* LʜNEF8mF>Ϸm'vWvdd*i.Gaph{ul"DЅ#jdF#`Ͽ{ `#/ǚ<>Q%wW^S[6f~# +jt+2Af~ ,dA}aH=ݚ܌SR:aj+;ղwK[^&>>׿>7ܨe46Ŵ?fsb8'" #^M =bozm"  A/ / 9λBq-%y7ۋoS %!h9k(o촖 E+qd*=hнPtiUL 'l5t ]eޞvУ ֹg̈́&d7\%^Q.46j4 W *p?qܧ#egM~u~Ge'f8DMg3#!oegj$" eW`R釳6tI#~mB) To#'܆Y>sXx7KDp "1ϤEtiQO+;ǸA>֜aP*7y"2,ʻp}h.8S ߳$u:H.;iI.j$i^o[r>c^J&Z__dh[ g$ A`TCwVF@+YdiNR\"Qat>\GR. ɐfJxZ̯ԏ!2PJম-5zϿ5RWdŶN4@ 6"Zv~p%лn:iĘ,jo\ʕE[ҙPG++<-V$ 2C^޷Lw 2җ)\YgVZ |FuzL,6& fI_ſΖSdgWl^TwWcB_5Oq~< :P.^q)I(Aʃ%b!:/>>R0^9~r1ϼHlZݲRqG̛,g?+FJˬ5b=o ^\r%w^Zr^c:ɇwv!N" R@IfU&`FPrMJ<:YZƫߧ0RN=v婊rSH?? Jv8V^;1mNc0zjs-5.ۤih[#wEd;vN4u=ly8S4+iʌy4#@!X3xl0L_#Y/m(I Wq p,ϰ,L}4%ױ1B.L4/_)&"m99QRK*mˍVچu„ELL4g&ɳWQ36`hYiFo/GLɝG"#RX؅g#OF%l 3}p0BzP> stream xڍtTk6R 5tww 0CH ҝ H4H74"!JI}csZ߷fgoFzm=NXCppEr* cdԇ"x`W7(&r`!~p@@_pWQ<ja`7iZ#V`[( H5[F` Drd r+?~&6YYSW+@ywV*0yyC ?+ w M8`?7  gݐ/3/c9A8 @v5^e 鿭*r=d`HssnЧ`m(7#ֆA8( lȭv@*nȉ6ܐ+5ܟ2dCf + I$A /`p2]~(# Cp;U/ [K Ox3pk` *Oε!q̃ǼCy8n'ˉzjogx-4e]_/L}Y?Sܴ=EO9~8IԀm,K+ZڍMEWƶ[ȗs:ɓHQH5E urjݯF>5Y_V"R4K,'^#izv(A G-Ϗ]n8CxU豓vJMw"ky9=Kz.|ugiٱ҃ &K` Oyڤ`#b$htۿFgL5_RaqD/<IdK(fXxwk ud|HbȾ["1tzw;ʟE~ȒZT./}G͌|ʀsU:U/Xx*Vá4#N#G ֵ3eފ''^S[^yal*Z*y0cRڿh{ 2Q;Fƈt^a Ղ«+kÆQZ-TpRZoy^3zEaYM"%F I;kw+SΣmU?"gQ,cIzJW2CԚb?pE:5՝؏X%=/Cw}nXd}^;)yފ?*Rx$W< ۲lc+" %َa [: Σ.kGrݝ?:sݍ]TPm  MQQ*3!P@x+7<0–)o y q`Th,}3Tj/FCn#C_'ʁ Q4HN4d{z5Z: j('=r&bG aX!oĝ0sXݱmez ^N`{JeV')W -<хL(x?I2N9shw/exz?ȴ f8}g't~z^qt5ļ46Y\VfhO-B>_Wdv'fs%̢1~FWPoR 4 "G30 VJ/1T)4d+\5ԿCFs>.cJiLL+י`yљ&7%ӫ{)Ꮽ5;"-΋[2K';+CN(L rp-[ oK nt׮Q]LӼK0I% 0a>Z%ҫJ ƑI9I8,2 jBz*J佸" ~Z:^ ͑v5髋)T5m;Ye;dHlW=5}q:$_*9}ڞW Peo]wrT*W28#Q܊?ղ3U37QwTÄRJqb˔`B9̱}ӗk0F %G(U_pהo\4s ߵl$37=H6Q=I}L.s@{X;%Bc[_̊neCɕ1̽"gW,g4v0Y 25o4!zqax=/ĵs 0O:f.ޏ c\tN{I.+4f\b'D[OBLmFx]|~ݓ6~zr_4 qho)x` |pǝEJ4 yv~h5(6|26:^zsb%P?ƼnF$YDZudsw"S8Ρ˂[.~2d4UYUմߐFRG>n'ٓM'cupletDX0칑˪xye?%3::3kJG4ԃO2CV|~&O]ZL'bh[cYѻS}R C=P-)[&EFPfGkVʫ[ O|4S3gM PřOm/ߎOFRp|M`{3cd{B =e"{9j2BOD.@LR$^,qބzwd,Iw:+z__^ T:^pǠ5a~.t3bq,n~_wsO ԣ6Y ?&xa cI6%^"mN&\& OvʭbYggXx'=kJ!^ҩUa&N|lN笇k63][ /DUlJ &E1ƇGv I'zxܯG뢻2ko,3 D,A J }PiD]=)>aQ7Tw..M=jB}uq=qY*P1n|߲'D!^M1=7ؕrѨÝN&}ޡjb7{o>vhZwAH.!4,|?IC~pOtX~nS} .*+å4wX^*I,4+΍? rc%yٜGZ1W^lťEk7R2QϽ2z}•%'X2l=G3@2tjej|hv(VҀzNf*~0[M]$X-.)/3Qkǡi"kŎ d;R硿>Xu0=5N,D' O +2%g'Q6"0B7yГoB> ,+#RRɼ: /ə?3eZ|~+sh:8Ǥ1M5ޖ>fWљ7{ Q z;VOUZ&f d<bv4X\N˽P)Řt~5ۂ!D}.{/,G ;D`UKZ_Uгr(sc ܠrL>,fyPb&xS&ZtѤO3oYRpc G++Uo R.?tUWrZ3ҁb}p3X% Za]1-oO1$o{HZYĸIWtAkI?A=Zɸ+ٶtk Ox`l_xFrG>[w[=LE e tD|yL/YZ)B'0z|+9sZ[aRQnzjӽ]\,Fx򞻢0ѭРCpV7D8:ê8L̸rDJeGua1vN˒>Tvqش|#䠬w-h[t[\o^6ZgiGJVf.*ܤuZ%^S}?=~]u :gM?DT$71$A{5:wۜ6ȶm1fѹDT+Nj#{f8N뼳^2 >a "K;M}& |AO:&?}/yfU^E̍T`0DL \U^F%ܗ.A[nrǯU?APJL=>Տ}u=M䫬Ź'<E?=<'npb*)íΕ{9(ٻnDNOPm-OoF{o%tel*jp9`I$%_A=ǨVP"'f3K׾ \ڨ+D9Kb ot_8MtY1M,:CSu4 J^\2rphMDcҞFVW8 Xq[t9h\N6,goK/aXsgnDi`b{nu3JaW (*52iOޠ~c6+Q඗/F4WJoЈS6uKo,DRm"޾ܺΓﱷ}'/®棿9,|,>f9Hͷlő8 SplIgi"seM{kGFj%c.Fy3pTu 4[*_㳻j%}[6^zgu@(UwlFVNcA+K k(Ob^/958'8IMSn2ھ|Ed1|7d +NP5+MbSB)z3h'J̾W.lJVP KңԔz%\)Gjkn0kZ3Gy\Gp U1N'RIlBvТlnH.^<(~nDkdF}'7Wkq"PITgޚ(zs{|3ԋ.d@}0I%2{O1Ǹ[fZD3 ޏXAg,υQ8]3?NybWec-=P(#͠M w~ws]6)z1 C"chˢ@#k p TR̜;ӌd)÷H3xLX;&١<"ض ou[33-,˩c|t;҇zK8)H[UK`KO`B)Vbg~|K^4fl:"j $ӕxiBʣ0D1#Yk#'aȼ\VF55,M ׾-?oi)ܿc)h*3bsebHa,DdoKYNBzÜV5\@HoГK+XYZu,fr)H:3Bf%;%_R}P伺l@z%7gendstream endobj 727 0 obj << /Filter /FlateDecode /Length1 1421 /Length2 6447 /Length3 0 /Length 7416 >> stream xڍt4kׯHDM(F3Zm0 fQw E/k.HD'Ir{޻ֽkϳ=f-]niT@sy@Yuuea23p_jBf+ D/YW(A?u$`!Q#QtAa6u E2"\avhL6kvXDpf A!h{5EZàh`GEyy=<Hg-f  P `  dǨd]a' ЯNfz pϗW@N@ddn>7 AG[蟌[$7 /^3@b }S oeqRp~3 e74f/ԑ@!.Cm`nNmUFC0!p,`P-j!Q_O& /f1 3?& %C1[>H_'(B1H0fom A ј/Jk̏JT%G^ҿXb L˿(jM8; q i>^(vj%?f\7+sNLa`Ъ!ryga1CMVS7&}NhH SdEK\I$mtI|I`[H%Y4S>[^uT9+Nq1錪-g=Hz{:ڣU܃ֿ3zi /sJܿX)RUcС"OzGez 3rȌO$JE>?K=2 _#X85g1.F|AA'tx,Rm-Ծo@Z7!ڄ0:EIa ":yN*V+RWɍrХDyӇLވIM3ܤ`thf$*u7H'cwyie03mYMRj@T uBEʾ^:{榫e(dM57;=1<<3t8<87V] ͖sw:K6mRlM5;ʔP?(*.7S`kd_jYҦ\#\ "!g棑\#GHu^2^m A#eDPMpH'1ٻ{CͨvbREb 2(Rf~`"Lw^D OB0Gew24IyxԀT^2ŷo^ߵ=&"#k]$AL9;A~N{^7_W^𩆼;vZ^0ɷ[gp 3T(-ぅn/'.$pP­ 8vŨj2/i8zR>OvUWhͧr%t}LĖ;cB_mk i?jA A:F_WE<~ N5 tΪ2n>ARD|ڵ%bߐu3c+oqL?o&i\V+D ).B$u(oߘ&۸d@ħ$uȔZդ683wafR >#IcDp0k0szŨMf}♳w_7H}P&9yN..N .Xh^HNh\;k ᶕtrOjg2'vC3J|-fV3Qo0)uqP0uZ;t6_Uݞ&)5zx\.~Ø, Q܂TiހL57Av n=ύ앺*xvV]hQOdӕuYfl> UHDc'',L{2%Me,yًN‰ϤxVr=4"LsPIP0B\T\OA#CcM]HtH$S&˞A]B${=co nAR.8GqÝ Ӂddz;U;@NQv]|/mX'bfo63h1 c v6vavBUNyc裩Km&Di3jrF`"Y "PpT~l)OG.)짞mk!)SҡdF? & bn::$.م[Wp`MsI$6lЮSpv^)<{K 9|SB8!#_wf;!+O8[IN̽xo=xȭ-)Cю͢w.uuJyB==x5p@XE}p(+@a` *v.+i;-Ve9 }CNxq} -* ;|-qTsD}[{:OGZ<voZ$foLL($rA- _Sj_̽ST'Zx$Ut/9=11OʿpN9M cn] si)\ ,.V<#ݍ%@}˞c )S80n#YNQF=f4vAL1^/6ȍL%6kO:7_wS9$5$r8&^Hk*d[aBkI(OM Ĥ߁Va![fIBʥ#7w.nal?p3)Vd;Ȣq1X{ꅅ-5/)woWE͌r)MD~1r>"0R7Hy>\' YtZOz~hP(`in/Z7xtg:;t3,=C< /"ò*s0, ~p` aJyhDFQy^6 H Pj7 /dQYR7y`)-F%KIh+X~S1 Vc`Q0uЭK]c((I@nۜX\oA)C")r?je`O&R n &=8DgDQ2!2qª {uhikhJNM[w""H*Ý!;& OOvQ^_[YMH=k=Lhdk*w=*\Gn\l}!>(ǓR6V{ʲb+"`\DRImspw[,VW r6έUoP37殮IwgJQpʥ ny&PvǽaQ\TjCjxcyS#ϮˬٗZ6Ӑ5?Vm^Dp K+ t]㝞m]|l9)XYcS )ף-ItH41{?os8f*}=ӏa!xH=k-u3ەI@*XQcJٓ͞9?^tZEGe➧ NX1U؝4"2#0CFO?T^5vBYtgXLȄM#2n8 G,a@3wU_"lc6;.:A+MG%qG 2Ly 839oS;g ݞ5EG{gHvooܗ4GŽ?4} rX}b^.mUaJau[N ahq=@CX] َXȻnzak48G!uQGVtMK  Fy^vq1R&` R$j]m+Ԛ r<됯{.O9PDR~1grb^eF_<U*+?s_e1fij|*]uPry6B<&2g2;(Lg)A;ƅ8{ǚЬ8= b?kR$reJFA.-;5ro pF%S^KY\9vDL?M4H6jpNլ|l$pLɣ]Őךr=$-Lk5C{KcNiɢ%uQRڒotM_nfrrCdkCs<ՇS_ȹϘm4NW/q[3 އZRH~@Q+-{p4 ˃ NNd|%ca`}-t7/ ' ^ReJ+?nGcM-_9J:4*̈rޖk5T*m{/ NԴw IyK)u-9wSnJx\p7%o~lyw[tkX<"~/;UF斫 IF~[@ش\Q|>_{7\cL} ~NUx)I@kWinZVZrvJU:}H+҄T#j0~6JdtX 1E92׬SPSMYP6T f׏4n$=>q;`/'/Yw(YU(ћ/Jޟ?5SGZO̚!:Fp r#/?B F 7plI$y-C&`pz5.Qƭ BQws}Ӑnl7p H6Ӆ*C߈Cxg?Uxx+n_ Za3l_$ȵ_~ˊ^;_|{тM}A78_8E3ܳUnXZGgzBu[zl_Ĥ2GOz3P{[$æHheVQT3DO"܃r-WE.=Hf'Ov~%1%]JGN=}KƆ>'ѫM~箨%Ev2Wk#rp[k>m7C82&gXLzsE 7rLR| ,iH`rZJ;(:/7>0E'$c!*QJ Lhk_]/m7 HVJ*aۆIL<#P /,U 2aendstream endobj 728 0 obj << /Filter /FlateDecode /Length1 1533 /Length2 7479 /Length3 0 /Length 8501 >> stream xڍP^6NHJ %%,,)-]4HHJwctHH|}fgv}N;@:M)+DCrpsD2j!uHA@0 `$ #Qnjp@ < ߎp@q0 P䉀"Q0[!%P#m!-%bH;'х`aCm  P;B~$tm.`5PsA¬ l*@ ǁWiܜ+W"(w0yBa6k!ʉ@0_`8*:-P/Ki(~sD@..P_ ~AYf%wt.' E@,QUV{gm YY`ĥ:Bd@Ab6$  -ׯ亞NF_0Np'5j Ax $psH #7; X٣:zA(q@>LQڲ>gW!"d:O0VQʋե7agoþOSb6̌ĎHm:wחApVùp옌帗۰T$g$ԄE%Hgdh^ؓqplk?q8@ j Vɥ1*Ā3pj >Omk>,=z,̈itIC"M1(MJ8fό$B)GҀ9!HMc|묜LL/U^9O&fOk{ BPF!Ё y S[B^*$ ebořG'n` nҿ&{m11)8Z0 9hԡSQlXeJm6WMn '3-Í:m0dEef"M|6@k{i⦖^ KfPTe?8spGoLϐbPlp-0=ʗv?J1)X~gBR0:B@*`/Iη*[%'mR&UĶM9]T&UVBl:9rŝ"naCEɉlAc,{/q}b޲ndqgOp,"ĞOh+a6jˤS>k=O]}ט;>Fٽ¶ƚHǑYEJlsK\؊  pf>!Bm>UJ_ %V}mF}GUm,FK䳭Qqɣ1>0A\:yptһ]quSGOJ;f~:FAf8%+تr7p52-mLѐ @gȰGJPa%KE;"8]anr Lo pؐH3VuIB^IK\VŀwOڗq|Q8~,$8{nwVMDPUx8SXWi/am8_h P#AJSF)n- ) ns;4@}\bѕɽ<>Aɝ}.o-j{?A˂٪fLl{ mN%gjLEߛ-oڻgSkř2gmK}9#c-)o9y .sߓoՅoen= .V_)?`E'SٝSL[r{DM&1z]> Ma*f+&ܭVbG>?;1:.Խ56 }YV2^Zdj^eMl _I*HvykcR 72K徧BHpvLiL'^I{u̦A8BN/tV Ԝ{reSxW!))^ Iw6L 5'Sط/e+ÐurÅŵ{ehO(ViXcTA(F?/Rj@:詄/E|16q1S64VzF| k=$39Ek-5fm `GOm_7owꆫz15^̇rfw*2YT5%tT( {h# ضcLI!湬G\_Zji`=1&k@osK2OOE[Q`<\y}lDvh#ƈ< MxZF$3s/*n,ov\߽!RSKvSc&&2|_ߚY68[pvקH9݇v==K2Fk{`ߧ&l'YL_x C,m T^HU~U Hġcj"莘|qUIN>g]K\zkJ, P.'W5R=dMhtR䣻ݘgjn< oxAvj`ۻJnƾ_jlӿa' a촬A f,D '7cԎ`f<)f1DOaizdo<Ш]}OzH}[' NF@[ߘ3-j xδG8.|f~Dۿ£]Y>'(eivFHI},_nSv՟ {E$(4 o bKn9<['?FN _ڻKŵ]p[fG_X]F J=>X>#nHh8MRXWm*{6f~h0wD0u0?RIR[IQN;3 g;E6 g4+$D_{]Vf/N;@0FJt v82TaB עd{z2nv[?4Jdpefq1Z$WLmH.OcK8Z}c:q6`̀GG%DqJ6pysZ=&Ul-1v,JU|3nVd]s(:6:QG/~zjE܍ne:u2P(vd FXo r7YFArƧ`f"iE]pX]%󆾑R*f[y1%\? y^[\م|'\pPreqbQsL~/.Y.2+ O6r_x.{_\$N7V+LO 'QfVcLKhNRƖ0Fu]|fyzO[|r'[0ޓ&9BO#w)Jk? Ef.tJK{n"*+5OUsx2T3$?To-U~Kz[Xa>nB!'KڐϪnkg;4 !w5 Gr jX'+e~쒙Oaog :_$ay(ֈ8 ]3^|nihV;4-:g˛Bg@8.|fG2򊓗'ؼ`\0:=CE<[b0nufc/{mղwW-\q 'Ofm*i'rsN%^ OVTF|L+ 봜~ڤ<媁'D3ȢԋNG7k_JKߵg{tit<-̥;8%L7,٬)Kds^e?xZSǧsJsޱ׷+ܵjAP^=KCɬǎ]γ,{guv(k|b91F;SV;󞆒}OpTC  x;Wy]>yn[a2ᥙDM'/1+B@2o8eFΑt.NЦr]7{JvC֭Z8OWsu;}.c9Foo2.~cYn Ys]˪xI^zO2~va p}VAjWQcICnJ,Jt=\o. 5 qS㑆o :'wjfG2P`Ϫ3%Iqotr0R[:j ''Dk)l7)eNp"n\ *?&9$"2bG{Ⱦ#T 8x9]ɉ*ZmD}+kW 2 GexCBKvJsZw oi_'y.1ʑv(gZ}~~@9Wqm/FAYCLHȤ.~-- uD-/ `اu("Hc+,s`uxY~$ <˞1~qhp"@ uu$|1Dy^#Ɂ G9F_ֱ N?3N0RANa:Vn>YwJ /I42W -d1w&އަGR%W Z9RV'^čqgTԲ}FG BoFk~&~c,F ,貌bKm}6`UXAИf'gJR{wCsQ5R8j!UMmU?ųż^WN:\E$ڬGͤ$:wTQO.QK#O%BiFwUVHG 9t,(5Z.\!2xh>8dI|;Sifnl[J'Z`>qKޕj2p͚q ,+p^N3S- w7!ی+@W|&Uaަ_2 _@˺^ms3eHxϪ0I9܊Wц!pɓ602%\ b؁f K; gɉ* g4ɥ+ˣcsB{S~%vY}#/+᱈oh/]1gGȒH}g>,jpR5<))-mXaUJWyԱ/W=7l>1YxkSnKY%C cE^Ռ!qm@=s'wT5E&ѲQszF m9F|:v;,jȄ+DBl$@GMD8|*< &i5Fg{ޖTnާw|.¸R`{YMw f!&E@ݥb=5= h“j;U/y,o6@w3i_+ERsId(zaϝhKȲ"U kQGF.Aw.կtnDcȾݏ v&P;Yv1) LT\V|W7]%8h7] ;j~Ir_IYڮf hș?1jyBv,k흼^l覔>͛KT)7Ckm(9|sEI>XV?US7V jc7֜Ïɛ]FM9c[|b :2OH}% Y,~c㖪0'C9dZ>Or5Jy_J) :ZA"K0w<'b/utkN8v w—Gm*WthV=}z2e+cpΜZlLH{Sr<nBډ2xHWJ6Dd;c߳˥>c^^inc(رGT[&@WDy(֝<}vq{*%R'=U%"dm# Tӿ%~B#\O 2tpN̲ bBQI+BuH-|>E?vhk̏߾'(,N54ˎ<reލHy)+(UmcՄ9:?7~sE!+vg&1Z(]5 EqPjG_Q7ypvPU?> stream xڍvT>%1Z@Z&!6n 1؈PZBRAR:APRJR$图{9wv<ם-}#A{\D B@%C ," hW( BJ\Ec1e(B5] D\"! `Q@e#D!^.%' B$~ ԁn؈0+Crs v|}}n^B(OGY^/4{=}_tP7obB.zX#H{'h s#PCAgi!m PnP?t@zBh?uBa>P+;q(PUBb[d D{~姌ðUn qv@ ~Qv p ?5` )0@ !`lAw;Kpc/aS#`h c;c}Ζ= ut&HQ K@DX(=Շ" G  (lL.GEag-b` &GBʱSn V5:p{K5Pf( ]."KGaN _=wE (/įg(K5 )v]TAPvNXLĀv9~BX ^ OJX7"">A c?7 *ܱ/O(Qȟ2`Q,]XC'?R@q- =U1'6"Dca)#GoN}WeƹVMy13gD)2C<R;>ϲ]b^E4'^$GoyPJ"h,xx/5n&W$~͉o_mO`Ԫ+q-ҋOLb-C&r^L2YQN_bLm?)X, ǝN|.7`d``?>8vIS\0?a]%J-xjD?"QZ֚ҏvҦZdl˵KxbkT) 5/%N-G=$#sĝ̶3&;˦vȘZy+Df@JSr̗b(y z(F#K֓Ab$i]V@`*:NO􁏙䠞?ũdYw6ɾm5Gn'! 'M#xR'ch:Y ItEٽ &[/oULxQĻ_MIubu4N6~pmRU{+ӆO)2Z9{mdu.6/- fk"A?Zb#h`{noI0S} ZAI#\):zLeX,h;=ܫXqRZ$jH@M4ӂml;=kG0W<{HjϹ1]fm)ʕz *B# dx[A:yژ^|gamѡu8a0|T!M,Z:nlC$֛MS> o(j~l>,;f~ xM_M*uo%L";.I?w~{3ޒO,2ZNS{M~񤌅V07Oegy)ɍ<>ԛP ~0_WaHd$LNHc9Kj0BZ# !ɨ\:WnMX: i{x.Gj]N8T)ӝC@5AݼUw3{Ϣs˫; ޳rg%J$IZϗ6HV7]F ֔LW 8=fJɳjD p~9'yiє= [,k.(eJBЫVI"?IscIߧPl'&U!^=$:9 f!`Sl"Yl ow 2yDU~)dM#Y`(QLOYȐ+]sB1># #mV]4ͨ ٕ7ph9!bjS3% yNLD1MyM~VMH(U T|b&t\քLk^ /Ylgs$=䞘w}i6~5҇5Tq[ni hyl9~{4ꄦ9"x9n-m& 3K*DR}9<8'aut/$豚΢AL+ΗCmjc^w+d6yһ 8I+ ғgᲬ(K1i)31s4aƂ#G}ESqJo9J/6ٳj9{{,MaXR2;~|xaea_ G䔯 ܋NK-w%5V6ȭI pƖ Aj Bjjq5UPĸp^AQXf,㟞8dֈw OJ61qx4CkPJue:Ov߼e7un8!DGҌ ̢E>:~3M^5j@n'i[  ~Ϡ- m+e1<g!WHQ)d\ d4j4@$%3קhmУܡZ) ܰFVyO, 91n Fo_Ns&Ƒy0|:b{G5 #OXMܛ?+B9; %kSiTW7(eJ_|mL '\nΒ31wƻDcSaƳ]0R4 M?]Fx*TI sSv!GM#[CiC^oHW> қf6%^Ph9αhr KcT,Cg*Y%Rې 3"a@(f 9ue{?~mU'!^_]m4R"V5=g^ZUAVKejI=ݷUlhBzzGtN+CK>$b(UpB{֚-hed2NӈLeҞsе8]7Tݖ' #֛sdSqr/j6כQBS`y-# jQZ-Q,S渥GA[o܊H(%k?P!r&*LӮa{p:rai(CTPwKfDjOTB Cgm%P^Bec+hZCm]kN%i8_g2~mS^mbbj8>'<"<*7ž f«AQ1wX5B(OR$V/S)dģ`79l+P:M_)E3z5v8P֑A(S6e̵,hs&{1|Gl9^TlrI@U\c.We.? zEwxi9М!1c(;eX܍bؓ(OGC#+M3] 0@)7nԭzBUsm?}.$Rʏݤr+z|r|7CbMǶmL`PlN*sB %p6W_JNPҜ>HJӫ!gW.Dʥi',%漩5oUamaºKHVKg=ύԝ;7զq_Jm0Aj9*3@#.v?75;s'nr~57*P4}}hq!dK{KWJ'D[P@x{JD$U3 yӥ B35d=)|ɏw&;mtNۨSá4#OZt(ro96 p AṢԥSB^=KѪwxE}ߪΤmo,Lt än33?BLo 18. ,)08lN7jA1Nsoqһݶp !CTQ&( ~E{?ʦd{$bFz]@nZۃJw; 'Rhh lȟhidyެ ̐ z)mhvu`ۤ (yW&Qo7/pX*td}I>=9%}z:?3n|P|Ḕz5WrU$QPݲŏxIMC|~98~2))U kW3\%0*`HU4)ac7\x9$E%ĐMR[z hΜ:>w86f'7`Kk?X_I*~^ נ|q.\Au5ɘ3I:@wI|vœ\'ލs7VJdIBr>["bi7Q:YWOV-t[LzmX 7JTxbA "^Ԃ {2#w&^.` vAnc x )b7A*>GTBjy1٘4DI΍O$;u}^5s0ww.J%Eþ;>[ [MiwYe1 ;>n}kO2_w$Aje.H5i-m|!{_ -cҹgtpN)20Wն-gP1e%*ˮ m) |{\>tNEŸnDIŜ)W (Ee$9H3KVvR|Wf!Y[ $T]@8iM15xZWuSGhelK8>  Y#\J6۲]4fG0Ń&n YA62f;OxdvaakdH1|mhf낔*G.k#[ܐ.O?9cWbT*K}xf>W^fb,n|TFuуv.=Μ%SՂ,R3tMa3S;8Zk.q)2s7lsJly%7_K >&$~ (gSN50Q͓_.DfvceMĴ8 #.r3jB|wꮹs?a9Z4+(r7%j.1Jv{Bpf+n}Lk2|d'n >s7UD2~֨\ Ky1D #CA26$y akN[5 [3)<}z[iqqRLĵ#OXUͷ6"@ %JRڕ݌Nv-Ѓ ٌ$ـ!`+ޱF}L:zչPTƟЭ 4*(qaI-/^d7͢lVYL.W(ϋKL/MO(Q=,ڶ_`"ゃ7 *>|=8Qt"o1Xqs3k*:V5ZAFr}]Jf y L b?Yn/6OkI3>ΛMÒ$ÁF}(UMc37nN4Ò^_8CPS=qnqz6pjRF@\9pԼ#; 5[jcϡk49}ҰGQ#U4_?$CMgY'A,pxJY:VW=Th9\ h}w#=k""W*Cs||QgY-tj귷Uۖ#7Y">l}݇>tGh2(r1MYvp|Fxuމ-?[ya<ڵdBOqP'FG l ||?y32ZRGFQX0~⠕u9! ΏORtݳ] * O [ D, oko/P$j/?J~[$MZ%uj=ctԓuxO _4!K 1,\=-zp|&$;ʾV"34#!V[6h{B;ģcґTRHVý /A$= >}חK"nvZDmIU9R,wЏ"aңY}+ Ύ[7c\uoT?M)])zlxM$5BʃBŧ.O#i*֫3J,i3ڽ; 1|ᛇg>>m#3xƔgpjգaPuP_W3IGUIy-urnFQ#b}~QYy8E zdf^Bq_mr~ |J<tHvvO:Jk"KuH]ْ:g}M۲&jb<%Q[2P"o/~G@ŃN} ҲEqNvGxM}>HUܨĒҤ#ĉL;p,I~tIDlOfnw8΂(}k-2ܻrH.mzr_,ƬF,EqpԼ^/reU-Y3ﵝ_-b_/e#d()PTaX}EH#H%o7lrvq>X&.NOv݀$Ăx@`潡,)ƤԆ֮cu&-4d$6Sendstream endobj 730 0 obj << /Filter /FlateDecode /Length1 2238 /Length2 15700 /Length3 0 /Length 17033 >> stream xڌtk Fƙضmi3m۶4n6_~Y+s'ug(HDL팁v gFf^*7B/)&#]&nn`ȺX,,\Vff9č\-M Y; B<Mh,<<\Dl&F D#%(-ylinUh +]-(Nٙ99K d t P(A2=ߥ0Yv6217yXf6@<3=dݻ߁$ETF;;'GK{g'F'K2d S1;[[ -&U` ;7׿,Af`bϤtpʈ]Gftp033s_񲷳4!x9Ύ.@*!L-M@sKw1_c0lځl<\O"Zrbt'_; `abp?/OK,F_)?i{&.4=A}?clobZ?Z#[Kߧ}#M? @SKq6z h$i4Ut66 _ w*qz** ;ӿv`hwby_NSs `b99"ON_!N`/z%&? $A,; `R/~TXL j;Iz4xL&E:;G_ug2d00g.\'{f__﹙d'bZx[AxYd^{Al@d~?19{/ O=Y-u2iv(ۓ==K?e ]Qws'dcdC~09[8 ^;z;'_GΚ8;}~i@;`:|7 YO4 ^K].()4ف")#?HP/x5'ti '`P~q lwpFQ.ĸwro\ ]SٯC|aш ((0Ι!qf EtGEϛ|#MC9a+d}\VguKCy>6M%z*qѫdq,mk|6sOQ>%$/5.$LTFtmI" {솻o6c'zD7%+.'Ni9iM5>Md\e#?҃$z[Lu#h' ;F힠̤<&{h[D KxMhN)EB餾;D*G 7':([H(c:`0bR%n"[״^_[}&;oIղj!$@#*CSH)^v/|)b5#:ƽo fГ 42ڝ/ͺ8\@y=Dt$hD@Z27j ؐwPj11Wޮ?vM੗|ĢXy ~ WJc5> t| _ =OP-$:tv*o 5 GɔEO[mV9ln0G!"KtМuQܩ ԲtAWKӽpRIeg'< AW@B9+6֒ < uo΋O SX8gI`攲dc덺"Wn庨6A,.:g6ֽ$6أ C; `4u.`_rjun :\( 2%!v1SrCBͺ)WZzU;#U !&PGq6=wħCҩ1n>Ǽ8p`B!7HhWˇƷ̤!SuJz0"cY03 I7 )!vUyQ3.#DzAJqC 1)+ -m hVzM O3Xm||6.hGPZ1ma'9lO68Fji5KgB!> H<4a.p8ʇ8_Z-U+nk*`ZN$-WՐyO{13ЏF4 uU5ީU$Ӂ!.X` nyeh}䫌ZQTV=[WM jBus[Bk_#[|^4[pث\4i!xmJ )IJG)o2vqo;YK]cC1a3Wӿљ\'&s l㲨q _:b=*y77ސӊƵ2BJGW1{Yq 8\īv6_7eHufT$\(ܿRے"R;:|vuכ&4Z)O*W\R2< +BŚkZQ0ݲ+k,Ii5PUA%~d9l9q&(ЊSI1cڕL8Jjfi^TCP VR~BLvqy2ߴ|-*H6\hL%"&S`"|^M0ogP7ջk{H49s|嶞Kw2 iTrQyG% |4pq>dJ&ڎ% ^͏ e C]!?L^=ow{_&J?*/q~dD !-vUe}m'4AG}oZ ŧ_Ͻ{"cdJ@K/Lҧ`a8uJʼKoI&ffwT P2{˅Ex(>H\=\I9W=VF6&U)ۇͶ☰YSv.#N _4l=G1#<F4|30\2g{ uԩ" ,h2ONփ@~CJykdQ/L Әߺڧ&7t|DUà!SVL~𾒣6`WEDq8/χ%.7氇;~m_}(暤mؑ(;nL}.IN_xL}ɏҜU,WUOZC43yM*$X]j@?UDX`7)]>BI@ Gx|;t!]Ev.!;fZd>4D˔2nO{ЌCG˩sh7?1q#3LZل3}{`00r|4P\'w֬V+~ 8qpi Bn:3I-=!Y`Uh)=e"IsT⚫QlW.a8"~aWJѼNj}2l|1@3#&R ,~wl4QXiZR鋚R$賬.0޹KA#4~LW=ZHpgDo(BPB+`}ʠKmslͳe>wY %-)% DN5} %//8!Cy}4A|ޮ (8ruosQ$P._sc( ?̨eFFoRՅOOFa5dgYv"#I io^!=1s'*!3 3`:*gR"XhF27ds0ì L>9t9 X;n}v;Դ2D'\dS:o?B{vjw~If UH:أcTMDh8E_R /Ik\7Ãױ2 4ؾiD9ՕT[3W1{N@/BNi5,pOd9SF6*΋AĦ܂–FԔυxA$F{e:jΛG_oy+Y=}ڧ;j-ʋ:>VI\hBt-àʏ8VhE8%t"}BefN^s+Nd#p>Km,lB<#3Ij_u5Ft O-)szƶHZFmt3_Wǝ%^^RAP+dp-]i{iyOSwz 􆅫dSo\,4\1Fhe,…gsˋi!q % ̿kSXsEvx#: '>$܇*Y_Z:5ODJepFR}fI/ژy#mglAgC4t p(-|#`e!$+^ˮ= XuC,\3'3px#ڐ`Ox:Q!MRsj ZxZ)o5yPF=)Jgm>ʷ25R#pn=wJ4?vr*gXI۴ U[>@ ~ȄtAZlgoxDS8Y~vosHUy6|Qwkk,Æ2™$f-eEhAtk;nL%tZWGe>gXs:n%c;;<|8P}zt9`2zp_H --Ϩ{1uwxl.{+OXJrD>f 3jTN\,$v׏yП3馑g&%7Z \LJhK-a^G"ͺsY׹=`^[17Fœ䱖bo-1*%I+ {ʖmp(4;'",ǣ vI?q@x{j]CW->q4$jw%Ciiݗ)2~xgXON>nhWGޥg(+f#w|K_M Nxo3D!XtXj)W )aib4B/ky|B~ԠH{S۸TV64R{zQL,jMiM ?6AOP)yȷH1+3hHَ!7vڝXo FC#_|(ЮbR i[?hyTJkءHR[v}*#Jw[mKs4ˊC]"R%4$xgxj 1>erӫ;^{O-T Sc;6muxi:Jpΐz| ,_%P@~%?lvO֋;g-~D?rr$X &Q䨵55,sy9̛U-,E(h$k;M\"ag?pyql |}GNdzӜPɀWOq`Xcӡ2 $ɓr+.R >XEkq}vgqw$t_&AJaiLJsőN9J54Ō"_;?IJPlR 4@,qĭk, @8G6g Y(9LXM>ڏ+ 8mɌ?4 K@dpƵ/$m@e'bX.2AwݯSYYGLfWS(z峤d=7_ws.07Ȟ;81o y*YpE綴q·{P+OQcFX}ºcLb?cdAv)btþ& A[!]|t Tn׹$QYrE]jI#:Unh$޲Qr)z{%_.]'w!`߆B.!w+>UiX^krV˶ BVHRy3nk&uI)wM9CCCJeT8&fgei=Eq\Zh:k]R?ȏ3{0&bI}.~e˃I~bģ n*=0-K9T#>?A%4iL=A' g\Wޞ֜B-fG 2{'<Ewq&3 ㅋLm|7iMbA4쫙 B9R%{3&ĆAM5t'Qhhz0 `E%WV}wdγR62z>mho X"*[jrB9mhg'ĞJ*ׇڟ\)F5{;LN !;cֆГ6XC pM|9Ji[]A'1>mn~womWM}p %vi Ҁ{y|8%|tѿM?-Ca.{Qj*<UfeZ"x?,V%W~YmZBpڍ6 p(j 8;c {BrBe&7{t>wۓqҐ(J6#ȉ'p. vnHqL\q`e}ͷLdm {*\4` #8GV)U/OFsB|,ۓA:Q@ pތ}MCZA&d[b?KA5MCb#|"xr^/2%YSҌXߨ)9yC5),c}KrxXUr/O2!lXs(E%x?=Xzx"bdzԕpW2R %RC}mvk]lu7%lYȌΰh]QO:w͌Vç^t+CڦX}.E[t^I;2ogmem_HYB8;>B/4`7'[\$Ʊ%chԥ_i)C_G@:]d';7r3>j*yh= Zik|ޙ/LeNZ~X|ؤ:wE55۷TW5N ;Mf:75nAKv#8K~W r0G2i꿂ӘTIh}| Z Qo}0 OA~5a8j2UU*QTG'Q_@O-#/]k\=(S袨7:_\Zo5:w>g/BL%MbR}zyQ_\AJiqe-{O{:Wm?[LloJ--E9 +Г)"81"0VKV6gԉEg^B |g('}/,i 1Wp:z$Z~jlQU{z Z, KWIP?nJ -[XsS-MZ _-}G&RhVְɷ=y1x݊oJ@ѷ>@K'r5yGȚF:裳3 Tjj(W7Ej3.3Fz?@S^2F#LnڹGoT3tEQL+Cش(8gqnYNՕ%1 &sƘ<'7sxER4XZIL e lISAZd^nDzy_1;*;yGt\4Wam,i$G(09]*LnLK^RXmPFeF-< ՛Ox_@jm-2="F-lοWF!A`MqYXnnu9 .^פ-r(!LrYeKP՛D ^V%ԑ*@xL)$s:PCoV1¡&NfW~mZMO?mwp}waܭ?i]Ue&ԙrRŀ"3ϫ1xL\dBC,kQ LJen[LcbE! 3c"F %øupI!C&)2kr7LH&51>6@<iS/_=EBzʼn΄r A$*O?%\QF+E+$}?D֓ј\\e߬@kK'>m{!i 0}!-af'ښa7NGcqJ!:JL J EbiLLvjVtz$b"!\+CyFU߱_CźA(i}rXZu)/| jC^-`jQ7BO;_y3GE$ SFRo 'uhGݍMW chlJZQšlM_XOU췋z(3pd&vk~R m] qSV"+{ռHk< /Hyd@Qm-ȊqݐP k 1OiFfY,sHp&%IBPKuZʆe M2K(ِ3.FWڙSAX/UZLd%VgY KLsV-x<_C~nZe"룇5Z<"G@! =ZށP*U)~C+~s8gZDܥ6#s~U$Wq M8+|''nՊaFV]N"8$*kxCGȟܠbHc)#Z.n۝I[ XmR"-+}9#I2חk8G}$-&h,dɅ9vc$t7\f |_)~llge:Dx[Pr˷X'?W( uf|[MgBK vi*d`[#n]TKaaJwȱpYxn֑CduS̼96xEb}q{G-R #^KC[ʇqUx {*$Åc1$oR8`',h>cv-9^{? 55k@iYQI s<"!uH`/T$?"&/D^Ȃf8'1SA -Yѯ2l&b=z;9_2{-FnS&s,P8V9d 5e_wFc;·0:"',~"a܋k@R1NOa\!_B;*) j9eW8 ۽A}v_bQppbFnK&n5`vrz(v]}dQ9&}Ft[g_tM6)k o:jrwb xg̦wpzO4O}m/8뵈Vfk2m7#"t7uƐom)iFˣ>>{س3oZK Wjs;¡=-aHz u[r]"U1;їcTnTKsa])6ejtžO.dNs^g˽_*AOsc#ci29z*j?ZU~귓PĺyLI  {u垩@:Z,IM)kBxt~9]mt$joд&E|%F#5k#3q4CiF]>R288nZV;%TD9p5p. *RAxAX{b0x2[͜XL,մg>ޚƎO|륻8?j ~|.TFLI[BǷPMLd-gͅGrlR;-&?wLJ ԏJov6jbUȘ0d׽"9t|6Z(~eCnDn/vyzV $jII yX7+[X҃!s$\hVp˄yXHgW+;gm>445Kf8y&>'#F>T|ELg$Ks `B]!n92췆v8F7 0dzcdiž\VUWaJDOSHkz͉ܳˏ֖݀2U4K[p$BA(`iO"YxܕtF1Ds_@U*R3z 'd֓-\ikKu%t%hwt6*sV[J"]#dCr\ [X2{9`r;2oi%UIơ)W_ &fZ. Tf X5]:*KB5FJ8qa_' n/Ek)x孾 qv`PJK/̫U~ 'ju-=bQq|Eo8~"7\kF:$Q[` ͉D&;1Wap֞w1-T.-$)I#$6t.ϑ>o\Vn|"JRPAhl{])NeD1h_wpy%y.˚ǛO7#>:$9Auk]%Q?]2"Y4)j~& -g%3WvB ӭ\ŜQdL<=0&$^\ Rj;>c&RH9_(.KyX(})9wȼ_`e6Wz[Z/RGib.;GpwEI[UXp~T^3OtɺҖ+9 ô怺\ zue3N;X'VN1X 7jq0boIS^K%(ܭ^2Z'ܬ7ݹ1U?rƃO#1ySɠsOVQz~R8m/c8UP jR1~#j[*GˤWrj-ў2v_F[b:crP K`:*&&MDw.Q fd6Y$?\e [UBm8 G%mkdoOMq:!s !ֱć0>5no.Ğ{LV,IXQ[s)$ݦ4'5<ZpEܳnj.[N{/.-d])s(ǯ tĩ덧 uhC3`^ׄEtbAⸯ UkYyBXOٝl1^˳1-nr :MvHÄM,sqJr.!a=ɺvoA~Șo6J@5x2"hdB[&#NJDFv' VԀpO="&xH Qq&'qoQ~ݽ7 Y aMxcs&uXjYVy,gB&;_l{H(I i '+b>^CuWf-S,!u:tL"ZgZT1)LK3#pߔ;sj¶[?3LH:hux@bpRsŴUVuPp7 E $4(fhYM"7]Thþ<{eSP4>_z'·9tbjwn5' =sSolh}CpyyEIv zdc.߈ Y C,m0iņoR_%D~v?-ll~k{}Al?ixl82IhB{1||6tRAnLő| ?-GL2 ֣G#8 9MV8|V 'Wi}߯Ra֫;Yߣ@@ 8+!s/ם7E^亘)2;ZG??Ģ c&z"4 3}j F~˱ %6T>$f}#!Z>ml8t.;V:J4Z.vSl[MlOq6V<2V,3:H7az폘8(H/Zīr?Qy j|r׾ .FVIA$'(n'I@V: #MՔ:S*<ّuPveEc11PrlH;V.mZ2]fĕ/ՃӘvn~q;tqX'i<\:%w{l-#19W`8佘y|W9݊)7CRz J3c9*MB8a/*D-|Hp6r `jewd|6c3šL%m!/v'G%w$\re^HJVCHfeHh½Zӎӈ#Q(AH:'leq(gq%܇UGυVQyd XvJPZ3NII/vHO:Ę#:?{6etd@a«L@iQ?e@}[gb7/;0'Oq-F>xן0_zμsO@Uq}F^ȹ_BSj1.wBE{Jto79_g>Ӫ#9dQuCyCz?ۀuZx!+͚[W~A⸚~Rf}Z=N/3HF E@8Z?> ED{ gv=h'DEn:Y"< q{U!Op=*dϜFL_{e 8-S~7iV+uR TNiA߬"G ,ӢE"jrEтk-%D] ;MӍA,|Dcr#*>,BnBX-S'X%-̺?FxV~T5:zCrWf<D3N *"ȫ nCoQCSGH'6݅#|řyQ+T1p Z%Rendstream endobj 731 0 obj << /Filter /FlateDecode /Length1 1947 /Length2 9905 /Length3 0 /Length 11090 >> stream xڍT6bš8])!@ ŊkKq)ŝ+Rܡ@s=䙙=yf7aQ␰YeaP7Nna377Anj vqHAnp4 <@0077[?0a4bP( `W ) -Yp ~Vy-e0_/1GG_Zjm'_X\0~ K/$.K_4#>o F_WGr#N8 A6@8?@p)@? \o©p&N |4`h?|pf3s t)n@8q? NzM~CuUO?2 ymWZܓckue="Π/ߍq.VqܔUp|I9뷫1/㮬)n2}'C?lTV02qԈ x Js##DnNvC#.M [DNR 'c|4wm;HH̥dkQLT*PRBER,FWFI ιH9MCVhak6?`Z7K*b{2X^(#(TӔ٩[JjvfQ6~6(TKPY夒-+6_ ~A`Zۋj݂%Ɋx$9+xI /+Qû7!21ߏzOg(rŅ+ ^+%Z&,m=J[h2nnZ봀(e[skqD\›" U49T]\(w4 ʤ(v+)XځݢJzw=vxućBV.1UK.U=Ixz⠢~ 9şllԎ6,|UHK)eIDh u9 |^].74 1t? t!Z@8Y834%e$Sežᤄ vg0y|MYVcX25w)K S]YK4 LGΖ!]$uK:cA39ۺ)tAt㳐]N|ʢTKPwVNyj[[mt)%\y]lLtD{9Rggu>#Q¢Ե͜΅iB*? wWfSJzurɘM2+Uu,lWusl&߳?!ؿ60Q~#^Vs$":Acʇ6 +Vi{޲[`+Gܐq1r.;Pe eomÉws1MZmތTUVщh$i>D K<ܙ#NU7."GfI]M$5- [Ԅ댆TszsGX6I?Ey,N^"H@@u~ 5VXs?9f&0ݻ+Jw^bDDoRӥc&Q>g$=!43%yU@/j7⿅tƥ<%X]bme,Fm6;*ϞW[!@ҜK #(c`$KZNW:[a>LK}Z}bv Iw/m ՅHt |HD?ӥ CinFw8X-H:4%_BU&9┽x?aab>N;{2k7B '~\GK՚7['#BCO]S`Ed^NO>u |HFH,OVU_u?t'dܯ#Q1ch8 a.df뭮b4uq߶-䭭؁\y 䚮 MN|#c1t+L,Ge LM^V2rJc;3/QY`x/$ipPy4ҷ-9fU#Dcv'@E PUͿ=nWC0(Lw+YgcZ/MU&5+=fhz2=WDހq&k-qN."W l٥tVPX%1Au!ZUHoSE81i1SMf e0U^AXpxT{2S1EdM̲t:bVS#҃{oh^`mM>K](J Eg/27ԸٿNŠ YP*'.v+([j1wquf f.E ŒJe֒i%=F hz%B̟YȵSt >܇'o\]E} +:on}MIbǞ[hN>s2T8/ 􍌘T j*B1l'v~0f->b[?.S L+ܢ^ml!@vb2x3d%g 93eͱadbL)m@(kHr[`[]zoZ&RX`wY)^3o1CW6x:>6bW?L(ǧhk~$,6p^@TI OjKR[=z&()P$ 3:ۍY$&$&v;N= ZwGhH<&$!%'$]IƅNՎ9qԒxJbQB.uZ-Y=IfVjoI@SV^0[5ylJZo@./AU#TqJ\ЕfOKCUUM3z\0 45EvGK:tqqQ)'SVrBv&#Oiij<*j|ػ]r15 Qc'4Ή{)A6"D6I?ַi竾>vY0J[CSעh2{'ΉBl7W4 @Ү>nژ9%y+:"D@:xTb^4:j=y*|]d6IaJ=rK^҆*C? $[kbo_N+ptَW@zXq9hSVsAaq}@oQd#{O0hh3;^< \>zP`դWv%`K꜠&5*E]0\F-I80<k-<צE(W#[v[|w/ᵢ$3~zmRi}-ePSz/׹C)P>!GXpz rؿC81qͲzsAk3R%YFzݣ#{䂗yj|Qk̙ȗ z qۣR59ŏZ\9L)*j1P҇LFhfO*:<Ѥ@.ػ&¢rCc~oeܤ6vhĻVËHqωy c]qr0U-pvCm8s-#ѾL+AySjcEJD7Y+1FWOk=2 $ VE)kb͑O,$g""!T(짯p1pȡ_"/610ыI/{eKިx9sP4~Ʉ1*O1iD:uqDŽe)Hj[b?3b޵16*כt>¨; Sn㏧{!;)jHIm6VgkPBV)VY[STv +c{y˜];z=Xm_` ^@&잱̳P '_ ikVka{ʶ]:4vDv5sIE`6'ac1Mt0G5S&؆o Сf 7/+ǣ&A'rO8LGjf}-A.mZ ԂUyq b&Ԁ=k^/}a# {A,O-D`qد՚@fS[aP2,M# .Zf r`}܆v!{ShF^AN=;][uӨI_c+K3bΗ]JDo\5+Bۭ<[ęs*.I.5l˶7x Zֶzy-Y9);]U80R$)%c0jdS.c76T9)w*]2]`5{FEh(?Iu?-c-*=T]&v"pi!Pޔ6nT2Y@0 v'PJN(HC~٬1 TT^CsX&oN߼l?m :ODEe?ΪEj 3)ЯS >5q2G*f,Z#i&]>q N>jr"z\mr,65rٲ#0\1sv]J;|WV;%K6+\ޅj^7:RA%,sZDr1۾ :QQ do3àT}tp M놕Aa32el}cv OTт4PnXM:U-q7*荲4wvkȭԻKP4t^@AX]w ͮ*c+(ZXwt Z>A8Xхޣ M#-nA,0IV &qI #ɿ$X1=קv )~ZoP1 );+^%PB ,烳0YU-iˮ7fYn|h\BFsꗞB8"BO,֢uk2?c1Olt!E Ư\Kr~q6!k\׏ӏk7U˝7'(ʉfΰ& mFGIΦ{0ڝ;8ѕ=Rh)xi<(f%EmՕ2f{egz:N? T}bi7h;4;~5_n}[=eN&1:*tޛIچVw!m=rZkWbkkBrSbh2Z%"0Za~k2mntYi_* #W<̓۟ǘ?aH_0rNDMfxUx5-@pKf']$Koq³۽H6o'h_I`w+I5ZEͿ2lJ;@qq<) >5lv{B\s%JWh4כ-:.d9gے(b\ڥn>D ἆ`-62tz?zQvG!Y&݂%J[ܼ O7A~nor4_[Jad0#dQ3<9WhuLh4ϘtR8r#2]D\G}6nI" aVD! S;da[7#e&d Ȩ5e䒠D5z+isrg#EA|ʆ7 $GÈ)A^(%]DYc%|+Րv~E7gRzkbUu&WKTZf.&}!U7ʽ5 ߌR}eY򕡉̣O ~cKƣq_p} u;k7ǟ"R MD#h)H`ӽMP}H?o.Lu gnV#~)Y*f^dXO'}y%Ÿ2,+1$3kE^$,8lxpIϹ4 ~t̒'{=xdc@:3C/0UdpҾa2Zla,%D 3s6|@7%B?t.ìydo^v4 ;í/F!R7ȝl5̶놚 B<%vk 1SH~xgNHՇX1:wˈ_BBSߒ9h:Tw0|:vxS/`"CH] r<wJ?PJ&OT8ewy~GGW0D4Ӎ׼ 5TX[(j >̴Ft!D !:_ ݅f Tb6WWڶ-Tph)3^LS.f#ч-qjml6ɽ%K?щJlSfU[RB LN c(e9L"\v\F _ Gކմ#X̞Ym+ٹ :8s~ޏKҰUm4KHo"2hz;Vm7'1`dΝgKy~#<vQ/T:ދw%]wg"/!d g/TKX xMȁрL-$eȆ0%e&gK#:O+BF9MqTL[3kղο0  gسa Plq<:I$iP:@sXm_ ӧEn t!ؼ;*oO x.Zfhf O_T~;b2jVJ: C̠O'%r1ux\X@\B٬UC\FԬ[l`p137MW"l֛eh2fxd Qtae:ۥozč`O50J+tmWJ[{쀬 ^P2$. e%;r305C[NO@O@.p̗Ӏޭe1#Jy[j)i.X:'D4 Yqum629;GdY; ]ylNČ0_/F`Lendstream endobj 732 0 obj << /Filter /FlateDecode /Length1 2283 /Length2 18681 /Length3 0 /Length 20019 >> stream xڌP]ҀNppwwww  w; WuoQ=G5 QVc1s0J:؃Xyb 2,ff6FffV u+-?r M=?,ĜƠw1P j `app23Xyc 7v2(0d.bV8yPXxx^:[A@ƶ5S+ \P[@LLv.4w+%@tvJhlwjuK+)A@h xP(9e,/z`adˑߋMM=-V@<#D07}ɻ[7H3w~.V F+ۿrd{% 'n 4}'ӿ?dneofWfLVN@ۼ, 3337+7zZ2@/{ގ4V?.n@O 0ZX#.XIm=}Lb"RtNJQQ7z_?[llã_IW?3=64@c`6}y^wGe7{?gC}B_4rZ[9 ;#3V.V@3e+z?b׽󾊙Gnqy?U߸f +'މ>f@[hz_x`rrD8L7I$K\&?`Cl&?`C{߭@ai/غ>Vaoy2NkW@%Pክ0rQgv?aF`'={dg ]Eޕu_[׈UuZxbo.H #Dt$,.77DpHVghl ˥D"ɣQV zptcdGc^N|9) nSuuGgj15!2lݩKhUVMȁTH8Mx\m>noK^lTRӿs|F ]gҋG31ծXMG#cE;vUral 'AuE}(҈$(OO5}8'OǤxRǞ:چNNYF# zsꌑI!SJq ,.۷(˧tfne|V \Цg^vG7Cz=zL>J} !Ҩ3@w60Jk;U뮯op!Ojj %WB( \R:[;cbp-/0Ew+XSsӽWG6 Pkh~93\ߎ,qYR9B܊tLbmJoZHL~)v|TLtbcb.~ ^҃[(7%B8OD[0s5%O2 l_T"4&er=/EO~@9j)T򆟢euM/1NH|LMyeY `ujz5#Iȩ9>0&ޝ-J}\$TqluXhH|EJ(e8ɋIyӌ)R?s P S8Fu& uB"sP~>t1+ Qyi5&C$#Mm)҆TivM..Kd2tXɈ|Go/l+ F)E/ӥʿ1YN;{4g[XO ?#"uߚOin4 ӖF%OdBZZXdÂ7SyHȊi/ȇ*:з==et/(M&V%> }j'p!v(@$|:2ޕ# O]BaRX7dk~Y(9 \↪ &2r԰2ˏ Rg4E>z5J'1ǺfbM8D1RYp`8ի DIr$In9Yf67YxUl8M s#T4K\+_7^hY6-wzKb,w{4OIԺg t0װQ:^ɥw^ًu΃ryS=`tpO;.{''bᘍ`u:@? _WxG/B~7 敹i.g>1*5% Nb3&'Q 1bq7՗MzUl8#Xf$:+1'< a*0Lsf [5pktX_(d.W enEnJ1,i}Zе}h(Eh6eZR{ :KM~rCuRfkS/3:j|ֺc ~\87ǏK)U?ueN(i 5{jO?|<\JzG](/(}٘Eѽy84d]L,B|A=^B* 0SU3AHq# OE|l))@}Yn=f'w%5|)nBS_{Q|l}*W3ҩYfflŞ6y |f\=C9;I@'z%ܪciI0ώtc~g#4||maM?=YvQT`ze ^=tvIl崘 *>I[:W*bs* W޺ewx(1<9p[@` +*-s6U4U8ǧ6ÙLjߧi0v?򾽴F@ J}f3=hٵ/P] ꑹ slRp&69]"ސUe59c@'-Z *ʓc=z=%LWn֭o¡w}?[a}%WʹDGMP|3V(3?a*8%01/G^inSe)"=ʀV ɸ8+,ܡ)bCr)+M#%+n103 -ޢ9ʼOȩ=%W;ȣ'{IJ{ꎆ/JB\6\E: H6Vuf)q~~Bh݂ jzS5`. yuX6_$Rw+Bvqh#ѦRтpAf6P_c^dcD$3zri4ݍ7T7 RPܨXR6[E> ^Qq1D,Q9=yODQXF>V PFqLMhi״qu3Y,4>Y HIE(uSAQSJC$Ln l&|X7F0(`.2Mm atRr*㖀Kpu`&@Ҟ/r1]|Nȿ+|WPQi~R-fvx-E=^X=(Ͻ|/kct{ 8wf`*5t~c m4gDrޏ0.$eDzz|0JAk2 =H9w,na1T cX6kVvH/*u~aNens6Aë1:kSA\Q4yH:y5Ed^IuAnpxE]2bͼ D+*/~~Yv)tV⊞sw !ΏƵs-`> /+YJklb>-<ijd :çcs0"Us I8D}Ct$Ґ-y8:cb1JmB0jf/Y<|?l`g4+0d 9L۾-l81{VoO Pn=2ۊZ3Y2Б>~ T% $IȅZ f {TQ:9Xj8O'wKz8b7E.-U+ϖv&ob0D0#CgT勍pN?IN#P_wb: Unch`kpMjuV~V=6Xr,>4{^w&8^:_3;ruŅe"\ːP\WzM7 \uE 9 Rk:^M Pϓʶ:};XUlQ؞ӿ}{ܥbfS6Q1+#\ +ȝyeqgpa`r(=Oih52RsoV3рL+p$<"oc$O5$1ȩ.jDԖtd. IEor'j,iLR?Aϊ{/}5G =s,eڿ(%v>aE|8}ܜ[1U[3)INW NNQ;g6v'ϐו dHٍQ_-օj^N`/cL16"r u,<5;G{ρ3`jIy݄etcdH5htߣ$x*$ÈQ{9gj[ؐpP(֩PhObg82Lҏ+.!mk~k 6J!Dc͸D^>{PkȎ&}<'bPPURXkGD`JoSм#' ,yih=ZmhgU^v3dwȋοwzM `~3{sѸadΓ9"lPD ɵF,ZX>Pㅦ(Pј/iQbȜG]7C1zPٟ ;zK;bK1 !8:D=,l1Cx;*ߖxs[\>k99Js#ӫs/wGҢCQ[˞ѥ=/(MRLgZK0O %q\y!'͏AY5Ǚƒ?:kJkfE%TuiYsRy6 N}CE1o|< N>Ɂ*!'U[4߷.~nk"-{D}[z-!Y7S J N ڬnÝS0MغQD-xg( wH,<a -"89.VNb4@xkatIuz_wSzVl2څǻxaA x9UsD<յ@A>Otrm#OgHJƪh3cڹ2& uiuctA7\Fg:&Xdhmꚜc6$3=x tS$Iwx2: 1Q P8‚XM#j;S)q۳ )6s r`*_Fљ#_ ^$)|35jr~v&Cd2zVȁ M[d#;t ?N|Ped(wJAx*p{q ( ۸;Qzq~Ml:jlDbuyR0^gsolװP& G>ޤ \t_bSz#12y:HP? p(4Xw5d b螽uz= >L뮂Lq9Yf&)'4d %ZU}[77߻$[ }+`!Ln<[6Hʉ5MV6/|]|)P,=^XSBS/ҟ }udOkue:쎐ҽ/ /YybN˾YBUz5i*5|Ji: cg_[!bh֒FM綊*яŲxzNa0*|Y|^^l4ka|mhAeGƗ_Z@ :UYv3qߓpB F~*O:#å=EC*?: !`v'˩S%_Hm o$="Lq5$B׵M-iSS?` BdKp̀UcibqCZ XRq%T&}HOld$k E\0Y rd }U)EK6!}9,ӄ{I os4E}U r/ͱ#Rh\_N"426.攺l2*qL_jm|o%!p慦M-iǍ#F =][;s$ td{[6b.G1b8ߘoy .8ի;tp79ۡ5rNczm̕+=Z/3-jLQh蓲c9ia?K(H'I0ZӖ?gKyh ӊl)Pζu(OFO<J6ʎo4IR֟98}r(ZyI;3x:c_6A Mx< ʗB:ѝȵ> W/0|hФR-)ƣ2Јڭ|C bzp^'pNԉ)q'>ߝ^ lg/gSG3*nڌ]{?n|z%oh&BJƱ3?Ln[9KXa8S\왎h-"qX)n ߰. jG7{1Dh EwHfc!G;$.> ȥѬ J`ZͼeE?0^E%c9/IYȀOսu8VgvJ8)0j/fkFJ`{|9E ڃnx*p|m G[\ v"%ɂ&#wr$!kwGCQ:Ls~ J(,Ց֮MR((:-!ڧAڡFL]@AE/>2dmEdw"2Q\$ZUu*BMkrK<ʰP2[ z}K}6k!6Y!ԋNG{KaxfAZM#kIFei sX $;kSp3t cl:d8 J7:Kkx_MϿg]ؿ|dL24{Nů\.2~"mز0DVvr:ٷ,p:kÔT.R@q<: ; bMϚlsU C5fKJ:Zq ;3l|Gi?7[4Hq\[>Ժ/?9gEon 67=iI]6\ HڢxTorgveȺ9Ƭe˝6s0V]8ݴNZSxx9#$".JbzzfJU{ooblU?j0w<.&៧-t o󿃬̚Kt::܇^sLqiتq;A|1}E_[Uatt Z$>v=(^_o$d H ArQL:²tQ oy50* c\y"H!~j/3ep-B\ ֨(;aFTg㨆\}% ㋤¸ Ԭ+RdZ1#nG{j”O@g`ŏoE{X*6(rջ.MjR#D׮O7.b0d2A6M Š5Nc谰,ł(ׂ| aȶt ĵFfK鋫\Vm;݀xr%}{BYIҨuB}5[o"x )͈.2!o9R\t5T(t-e r˘o%=<&IԊ'v;qe(L >5JڥICTlX4}sJח2QC C PXH>VhdX/sh9 BqOP>b"[|d類.O#(tb:.MZষ'F[bdJvlW{z.A6+ CSʰL}=NFxUR_RnH3)[3|h:$j WoHKa}tVmĬ p8F*hUNsZώ(2@=riYQ5σ7OqףE%vU>GK=Uhht;E.m7zb9;6SsrkdT>c ! .%]s↴- 0x@< O2qڥ ߚ0,WI Q7u`i~:bb@A0vêTX?1ZȞ TsN/P>&VjO Zf&QsW;>PMnEs;IRk\dh FQ١b]7j:Nt,9DSx\ 1Uct>4XaE/OYY{F1WJ:1{q#Svcj\7U(c dl&y=/%7v (~ybDƄ }םnf5G·J] Tec7Rg0C#>Q/6? ?z'͐N굩ҕ i-9q4١~*܁5^ KsgˏL3LbmT'*ufD۞*_w3kF_~SkmLb\ݱ 5hHjFtO!q}R {UK_VY\EFgz=-wtIcr=VӀV ՜ҞZ '`RW4mpoe9cH`jr=zU?oNSapUR$(5k| J 2{qVNwZiJ`SD{<ԁu~eYt`!sziqr Ӆ!vWkYOS0oLQf1BF<8\>!0:/qźwȠ/9iL51b=M1^yv>&Hd 84ȏam#^h';4 TL^#tG">HѥKL͌0C=Pj@IwԀ^?=s6% }@^]ll NÆ6`/E=9\D0>`<P7wncUfߗ*R㒸 D_O$e/'D4! ~9t^BP;үz;JF=s]E ұN=t&|-*WI\5p=4U[O3O Y?"baixppGo~f5L<ŪPAza#3V$ؑ%]cBw$KqXg0 j7Zsyϫrr'd8o׌ m-zf}b_;fϺy'Orc-sytWcK=|ϿXOۓxٱ`:N I˫x,O<ΫȯYwȈ2Xyݬ%Ks 3k&łޗw m/kTJmF7fy ,swИ,6Yw0.6w &59V R97*l5-!!ZYXZ~=)}`°Ti1B #EX!wg?+3?=#sn_: 6(d,5M"\+Á m4$>bmkMǩetHuC? nYc@G앢zOһ"OZ** u6.pɒou?s =S'6hFU64n +S(yTnKy}E5{r {(wo&dRU9bs)顼ЫTw Q^ 5y̍2R0=/Ph\+LE~s @h4Ɍ&(˝̹Tta}V%9jƇ on),f*G'FaԴ{ܠ㓅ö/U2}5g JrjӐDtz g41nyw? :K;Pf%E2X;bvl ,mUsVtMtt*|"^&c(jE-vOLc;..$::fv3i x`:eZltDqN)@$8ޗ^+Fm cY?>2}\}O7Gpl!6"Nb"qd`l-A 89|݈[]ܝIJ"%RV=zWe\Z{ywi8,R *gWS]9b&mh{U*qܷUOl5|+INmt YſtqſzpwBҞlB IopN0P V*=#@!6wҽk)}p'%='5F[WnXAA DZH#+W{k}w~/d_V>&UvU5!V~It_}(vHdM)+s/>Z_&ncPqR:LWlŚ- ۰ g#,`~Q!@ 2@Q[/sي]k*R3u$XnenR<r*y_@W`%qsb;Dkĉ)lRUet׼y%<18?ف2y>j~X6-׆:q!tR*q@I ]̲#';tʱް"5 mvl{ptQ1 |Fn29KJOq8=9. z^)wʗyFf 1Jirz$Mw2-jªjeaY3f;TvtR<.7G?<-#JJ/l+g RaȚ!ԿvEm Rb3@ťoTx_.ܱTHG6H:?roBv?}0 rlv(ix;hx5s<Ք ʡme%TA^L\AN腪:kERr#"Brzbع2|0Ii:`Mw+"{\D6Y7ʈ,d#LA/JU-=#2|G8.( S' xT/iv F 'aiC(-`ܩ8p)kÙK],>0eDc?Zg C3 04sƬr*aܵed H0sLYe [+*4;B[E5',Q?.uELVnM>H߫":z%p,j:iQJ牜;E}?d~QVJ,p`p&jh.ڈUpAk==`)dgp_^%dcMNXoa=eok'RfZ(? @agZz]1*u46qwM?8DG9rg'%ۢVA4 I课"PQ_06K"ۗ\x呠>'0hH6@*ɇz~RR]*OP ӹ`Y`ś4@m`{Y?F QK3V*ՙqfzsVIs >Z?*z}v..&vedD'\'sV65]A)u~awY3Gn4L.KP`'K:NnOvLpJyP#\k[7[19J)۰,?liI 4H0ȍȳsbqިF'1XьG0[!Ԙ+X][Xp*-ȥPGMۑ/r2d )?3x;tL;!]2ǭ, [tb gǵͺ:(d2Uc\f-R?M-60P,4o›yӝeAXC'!C{rTSJfݬq|(N=:h'C2ph𒧚 +@<9 9> F+D5œ{*5vCt 71I?~ڢp=>>/qyi,X`)LZ^ɍn6SC}j|ugX dl8NzDx01Q+Zs 38muiF%}ǀF_h%W A]4SnC1;GVg1FZzFc⭴~l#Pj)<2KW0fߞZaYk;ZiE݇~핎2;DXGKϝj.6-SN Q½/0-_85Μޓh:ke/3'ʄs9uSML]:VҒvt+*r>9.YW`3_53Vq̀lB)Mi^AbFxLl# V r?s08㹙Q- H6t1tz[ل (8~xU 䌛qձCquyt܏dfg@QUk0cEKJXKOWg}Mo؇u@UzwkdSp$D32Gb=Be0GԀ*ô"$AͮhU[;᜼m.u[q8ºkyՓ;vB1@C5V_hЁ qG-|OUʹ::ZKq9Å7{ʧfA-I5,dUѬi%:76&Ȱbg-6.0-Kx'9fB3Vn9[yCw /%h|0:Vye2Ab[J_Vs.BL8TFQdY8B=KLngw;0 SʙW6֨CƝ̡}ţE] _4^YZjz08ZeepJ.ARc76||u7V=r\ЕB1.t/c]{̫/miՠy; A݇Ov0_މfgM~^:m>\L蜟^j(,@1rv9A48'*=ӻq$fsSr-w 57￯,n3RjNwԛ 8@ fC-#wPm* b" ZE[Y* }ᠣoƋCtRu}MS_M(^q\nk*m'f@:dRnGKܶ(<|"ĝEj3~ycQ: X۝s oӖNykt cޣX^~0z$1rDN䈂1h7'bqtc$㉬aE٢t^5˥#xh8÷$A a" t&Y؟5$4=.XceTĺMSUh"q1B8[%8GOM|}OVkLA}T.XJ0#ڔlR~J)X$46c{)v ʧG9N4tj4Qu0Id/E0+HrZf#ۛEՁo%O?^}96vizys0p%$ejV֡F@n:a_@qKRCKP+WFjY'kabTڅ6;= +vgM︀`!mI/ܪu-N%ݧPiKԖSendstream endobj 733 0 obj << /Filter /FlateDecode /Length1 1478 /Length2 7174 /Length3 0 /Length 8168 >> stream xڍT[6,Hw3 "]R030 %]R"" "H H#R‡z{Z߷fgu׾{s!ma*H$(j%@(DiG2pPp$BQ0ƦAi!uOHK! P@$J H̃S拂;8o{ @|0 A hG͎P о*-FI z{{ @\=(<|o8󀡼`v_WfCG A78DP`M 'XO௻@)WBpdtu |=Q@ݯ@&@lo~P@nE=<.( *ss;E+ u>%8 v_?uF ~{8 ;O7A#V+D@ !1: *o20sCoH?? FyoDP4GS ooO j)?>_X/$ @@"esmՅ:`= /Yp52<2 -@<StM{ On w+Fʞ蛱B CM`FY ft_/ yÍA"@?v f GCVGt_/M?:߼*7 տUF@vOHT A 7A?͘|~ (@oR7H~~#Iq $(S_P ]_POf HtSMxi<7Qaɚ2׆^wWO;}yr|[ٔlDz3sa~уi>o32w_p {G+!!L&ZZ~];3&ͳa!|4-"7̭_5l&ӜkʴܡG!ܶ#2 ςZi vhA7U1h Y%34)􄈩$ގ qe^;J94/G1~5.1;v~-nptQ}o*&JIZb5?ٳhd5+kbQfr/<_ƴ`05$DjdD䚎 ],bEe/k>~"{D vvp>ZaKlt>u;cA~p؉pQDP'WG1wOsw:*UѮb`uzm-i"|n +% V;F -Nf;a4OMBNTg/ɒF=80_9;=YU`E[  TEfSA.efWAt>W5ysإKrjȍ[>%0&d)HD%uJ~&njϚad{vٺP㌿K٢đ-Ҟ¦C.ܺj~fh"}Vu18Л鲹2Mf󺙤Nu `M Q3uKݞv\{W"ohf`KRXyV8TNvN(yKEF{doxȆa0+)T-{w.A hO2I,3sԳ? @D ũcX|YO1ie|yNxXGcGTf%rTmBߩK 00ʕRP[(P'2N@3>^WeRlꋚyt!r"pVꎵ5Okj-9c&[JSceVpK(յcWulە.ѪבĄVYA#|&d<LjP?rhH )GUpd%cck?͝񒪃u҆5?qyKuJ}͆1=,5w̿07 ̥՚2rW[hyDV 34Yb\/H̢AL}-udˌlA5h@םkmۈ79ى]u Eox&u GPTL!f9uɻs2=嬶ށ9Xߙ,)ĉ{B eps/;yzg&xN*&Vie {)ie4[+PYҠ-[ %tܞ JԚA ZrvR)&tFJ4j9ڣ/8/bf*"NS|(4}SF_&(wcT`,\MD:zOl_ ԕ2[^9ԣ}jF8uADd/Lz죆ڹ%V1Erfm !|i870jZ#CB%Δoqm[iNT^uogfNg3kqm&(M<΄0t;Jj Je 0n.qsx/NjW^9S^ 2=T}{FۨI4 ZhL;Z8 taY8NQBE=X[[ z΂ɇwf래$K=z}y~@mc)Aͩ~฽Y"nX1['ub>x%EƠ_m2}"ũEnk{c[b?o]!lL+o&ٶ=ZLZ=LSKqDLR.\ޭ(#ۂKc|Y|s 'ܠؐqHØaK .CպN>1"=ZݟӍ#3y["Fiz{vQkTL#w,ÏNb)FjLG:^G3DՂMw OKDz$;G>t%2G2eb:,gDQ5 :ڲͺ΍,W@VXj#AZ(,vϪ`2<%B$!rJ/+;4+Lϛ<ۢ"?'N)=+&h"~jk0L$Ixv[[!o/~ZˍBj[,<; iԺy;gpft[Rf|/s0r|W#9奮^4zvGuxCޙ/Qf7ط6h>SȎv3Ws3%Qta@wa#Yd;x _>E* ؘ%,IΉ;RK i-b] ;ʖ(PM)l}JZ]wDa:s# mxk˗Z8-jdU?sdb}m5#U#.mal͕wPDŒ'SzցQU@} ,k| :b6ǔNvQwiygY{I+<3X|PfE ?C3^.bHdpw2@Ƃ烶;*I# nc,BpccV䳣|>9Xjm|ݰlX{1N'ZJJg!z.uzz*Ԍ\xsS,8}ũ'-A-1DZ]Jn]˓{݉_~5_P$ªigvmQx:a&R;85|a2o 4ם^lېmJyKgFmط! YhrU;n %EXi>O[Q&7k'q =/#/jA[7M֙YߨJfXwP`%*t<̨YXVHa.M@*U}a mR*E"W I36+ݪj4!||S B" FEȜ&lh[UVhR6 -#G6zpݲ4}YqJyJߐu p׬TA U~RtփoYF QRغm&51h.v"CI~PMlKc{D]^F{ohΚYb ޡ5KpT62)"HO)y7S2'S~ϖzf-)@hi"e̩3~!)e玭S䪏'Zǧ?l>^mv8.wv$~ZTGܳv%28uEASCW?C" L/g+"D9gvSڳ{cQ[[+|hsJEDCq[]Qe,+u[nX[k]t)XPƝ5vV?oiғ֖~8| HAZ.O|7iC՞|Q5ĈO,Pr_{q8;O.y1)ֈȊ)c ܘ`3,gpՔj yHg~8K:GˈnNƉ!r 4#<2Y< c&Ʋ ˵N*$(r[טo!(,8gp.+9S=~Sxs:cyUI\N+ىKl"e VnL~ k}#^Z$||ɉҧÀ;>ܭ(Jo<ȌִxG)[~ɖuHDpe /4\AL"=#غx=K\%ۯ([) G{hi\*(~UW7ñ݊ںx;`:Ѯ=9c B> Gm:+9.[oV8ݯߊE֩<$v`jV7ك l ~OY)qYO9cEͻ uliD«G-3{9V} Tͷ#o K J8{ 0p2y8JyBK7՟rt-Vwr0I-w{K,pv[?`B'y+rD%ɧi5Rtby+9lyJt?qz8p[sQw"@O9w`{}y,7r}Hـs>\3Q>#1e"e#K!i@E+[(ۻWWPP*[|ƒF$yѢiҚ;{]-Izn/oyw=h08vI%Y0fد: 1zOiEdvwp)cE2YWȣ淑sr mQzuOmFhQ@22&t!LNkX2TA:ULq$ʧSv]1$Z`L9 9%d)45':`5CeHd43܊̪LK5i %hd㎗84ryi265fAU!;#ΓgGNu.O]-ǘʠ@oO6I6: '˟uˣFR\?'س: cբ%p?t%k)OtWKUۅ G-n)6GneH ?JDX߾̀:'PpCq^f\i]WV / S!T-%71wӟQo =M9Xh$Ug.`#QTgFt6,QLjN.gqX=qƜ bI_=Xh t2?;N2ZM b:)D^Ɗf6K e6ЯƗp ) `^0fuaHӶ{9#}r}|"OIWxqF.ѥ*RdZ?q*!Y nPC657;,zt'Ho=qˡendstream endobj 734 0 obj << /Filter /FlateDecode /Length1 2778 /Length2 19851 /Length3 0 /Length 21430 >> stream xڌP c!Hwwww@ap%www orszYݽ{=+  ['zf&3\_9d/ QX&f6d̬ffN&&  A<1C <@d tD ٹ;X;y@eL `8@`alh 7t2ڀ  c 3wradtuue0qd9 P\-*@G 'e jQL\ h>lktrE;c@8f}# ۿl m-l@䏡#|lW ae!8ÿs4vsrdp#72ۚllNpwslAE&0qcTwJm!̀Nv&&&.Vt36gCnKG d00 x:N@o+!03L,F@3 [W`1? 7.xL~0_-fUV;"" 7'= xoI -_mMAp{.^j2( PG&v&c/+ב߈$SGohcax!5g&6W+da[3 i(a4Qp26kbwk [}gfb?:[GpR ?0tp0tG` ;;&@F` r(G`yEFW`{EF'Q1%_ Q_]^]^]fWzE`vWfWyE`vW`T{EX_8WEczEXA`KWf0t40p0vGG2 Gג1vz= f11FjpFV@fc{(qލA'&?#?\`_TW` r;8w#pM-\o٫G 8vL4w3,Gj/տ 8s`g_R6|3R}قwn`j[g?ٿB?נ>A: NU l6濥jht2Kfzm(vJ -5?o?BD 7;Zu#} F]=v#'pp~ֆrN0:;5V9uu9}r49;P$ tN Y x 7vvwW|U t#,/y-k~}wߛ%L\vhw~@KpNA[Zy\S^+dpm?!<оדt3d y3W_}nǂ8dKg##>͑eο#u'|K uv#{L,-i$k&KZc;Bi O$Eˆ ,&j^g}n+ W~KߐnM~b!9N9:1e^}uJ.9I|2`qW?\f޼ }$˞B{@8 P4fw,]l9MBeqz|78f&8kdLyE-@e=Tֲؗe}v0ƕ)!Q^HFx{S O.BnŦfv,.>(QQzD׌=)^.FkY&'$*DA-g0u aO_(c*Q =%Rz 5e_WXXɋK7΀U_ ![o;zw**饢0UOܤg["'dBq5fo ъ~x+`oN?uaiزBxAEv .haM{b=_\xʽMs}$5h2[0nW˨ۅ5e1] ?L6smYXzty15rS@w< _;ݤ1]>E,<]gl[S%I2ro+(I^w'j^O6}4g :kOj@bG`>BR%~?(Ch @GʪC¸(֟Y)-$lCsيx"];Ԃh*x ]fh%ǎLz䑁m8E⮲gxCƒk4mS'o&2A BɡKFsF9 a@)_DXlDLIt4OĔ FxUD'>xW"wt!hNE1(bf6))Z<_h-&Hv 22F|̖{ۜOdl@ou=:\5gCP3%7axh1Վ8C|gU:5o/IFay[p1ڇ/qT ;[H3owD''VKNf"`;kQAk+Xg{ 9i ljwGy.,0\둖 lS'?"A[? ;U ppΏ2 ­x`;C21,F4^J'̪Ǫ&o!iPTL[ysޙKCoJBRgQT[*e SPv8Gnt+qzܡr'xUѧE@"={SH(Hϓߴ ߛ3='ǯ8颐  iE%}}zc/s&e;zFC<{ulh ٝ7e.*B!ql0&=Q~=rzVzHTX ־PLn_O[ |??X"?WJU&\̅h:Wis 3 |ݐ &IQјr7 fSƩl*D>3kɱU{z'&B~7~߬b3^n| Xs7MxpMf8't_IQz/}3FÝa)~n؇ N酋_]wu%;=LKČ Ļ2XϖrޓN%('MXcϛk1RO/G囤q.مBc8I2u'ǷO.q1M:(5aƘ֚Mal`VELKٿ [[NV7?cN8凊8%+ ;M5ȽP 84[5OLjDC"+{9 9H5o^Ξ~%hU#ߋ%* c8- ݛt&w'TcBdLUh,^˾kr>M|K+^Q%wܧ!U:@z3 Y(a]R]e* }O`yw'1+[m53jo\5ÔЀI(S9ֹZhsYP<71-'CFy$YuQeτÁRpH k"wLX >uC3n*_\:^oEWں-8ioYzJ0u6[CՐ+18M8uBj*A{W/C ƕ=9Oȥs:U~O_]Onvh<ɯ2,AFN䕴 o8]ac6ZЋ'DGH< aGJ[sn't<¸ Vg }]?Wcn7dCDgH ~lv gfՄ[R%I*:y"(2DWVq h`$㝯8JЂh~({,L^ Nk3 ۂ9BJ-ݞ=ȋ!w'wv99EߌhP<&.ڡ:bZ /"!n$_ ܽ% 3pGV߬_%pn"sGYC3"An&qC]dUǙtJ .@P[ ?BM >~(|6.fLEu$DGg+ H"js.*V.d^wLv? @;Rʡ.C/آ ǀ%Fw)-eUn?zhqs![}^ La!qHwLP܇qA;{N\º<:43|9s i 9Et4ti5`,jU{UB$X{RE9H 1%X𓙼KP]y4'wLG`qd<.-z jfC_"u?m: &{N`ϯ*TrE%q@! n-QoX;ePktW=1q^ｎaoq:~Opjl`  Ovr]Z*z[ز0A!UT4WmągVXs.0nݐ'Ãhkx-ܾsfc _?9ݖ034x/ vO?Vy񥻜ޭ6my,\= C\$ MAp9'0 pjHI!s?*]8i&Y[aB/רIC#:<uT{7o0X>xGvng;IZ2ړy9X8Q #CaX$AhԺO7PKUFnh 0 :æ/QrkxrmO:s H#;~X֫=vtW^~4%pBov60.N:BR:̌E.avlII@IHaCENsLyyG3֯?x*v| <,6fM?ձe'[?Y޳[<kjkzMdljoEV;c-$Lm#aygg/394[c'@8Xf \LLOm( qֈxUպRJmN܂XF)$PЖUy#% :(QlCd/e"L FC(t%im,VWdE{i^x).U j}aRP},ɵ{Uۚһ7 cHMQ1 ^¿K(SU^GJw˹jK5v9RlDٓM®9b`Dž \y ƳI<3xL6+>%{em.~gnnީhٙRhs@<Bl58(+ಐ!A;Xj%-Fv.xdE?+ّYGl4q#Ge}%^/1We/db]+ăɐO4@~h5+_YՌ7iS~2~g+ҋ:A-=~瑊±P.1-pxNWoSuЗyHL6aO40>o#<Dw̚˺xp+B/dPlN2^6vR#S[sS\n(Nl|- :VF|M˄Rh#/yol{̒Y̾q<@2Wy0&Vz^@k'!IL '@|q7x.KOtT%+&rReD OXzz?, V2OTMH$ ^pj/g3]I@؀pM$kP̣*CUdk%_3c>Q߈M +qF--KGjderWGi}$AP֬ œUKX$pw7[' 4h53|'lD }D4c#T$#Ѧ/dLfR‡$y5y&kоt,͠Bf2Mӈ} ʟN4\1"\-$2C ҃F(2λ*9{|ԉɈlr6P.~6W C(v e;|^; i,oe WzON+e"|>L/2哨tjij_$&e*kq䷄:")YAi41aWcv{(be'F$oƛTښmo8 Z @s0?b࿖|vR$ە5ԞvsӂU:ɜY?Ψ[/?H ŀşt߰tJWQP?7W&cTc\ ry'wTyIɤziz>nSM< öIdBDTR辢E^iNuMĠU1E)&LUiqZ{6Rh&2{ {vZ6:]s;~6ca˯Q 68V~׍-Jhg@jIq'x?ekx?GSzok1­͏ O>쉥һ:pZ3,zށ3H'C<ɬKI `m9]x ,(bs* ~IJ:e+{q};#OyAF/8rS+jl?j6;^v{qXjJ0p݊lD'! l]=DOh^}n@8pƮRQqeٵǨso\~ӨfZ Yt~}Got5Ն@ +[>k$99dv̬iIS)墝T[QM=d7uT1ù"3q jv 8LԎ"z/[-RɷG!e*.?cEL|d&C<5$l>nx.m{S(Ty*7"qoi4u'*b5^Ԍ~;/ G1R޷׈G*U*GIV lȶfc-uIpLt`q$783d9)x[J>J)=vy+[B1 44^#ڼ/q6U-3ƚw&3Ӂ.tO{ᳲN 6t,ؗ=H´L#)s땒:t+B*ũ D½kY]#;X1#QӠ̴RM?d IS,׬X/0(#-XJAMž${ISlC*m˛qb`J0~2;Iå7>C`(S2pYGce-m-C@}HkH* MMpgSO06d뵰Tڍ)*[5`m{aa*EjwN!b3>&ğ%U2z1 0hX FoUѫ :,^n付\3Z+स1AΧc2hXԷ7On[:,iP2sJR8R!km҂9U7Ƹ=p)L^h^78S"Ux2Xu /3;Բ 3!pYe2b̖G[8wS.K: \xh}chM(AnL|lC<&Hm+)΂͕>4՚ۈ& VG,,[X~E;ٰ_P*[*ag|ͅH:zW~SBPcu;o%=LW>2GхȊVHkuAˇJcFf- T{FhJ`Q4Dh`eT`!4-fyI7%24!JgjS+UKFhK-u bzؠctQ0k'dLlT%Wf?5KT^j9 : Rr|fe{2h/l",#MR1djVHp;dBflKR$$Q`Dk{D'X.<"nVڡ eiT.pa"H'Tmd%~Җde&aG* F-8J58=yS.] erdQkWgz|N^էܛܲFH> y ޾꼆_5яo~ P7Z(<իdj5f/tYu6% @=DB?]+AA9wkӗ^ƪ+uQba˿gyŝCSZ"%JwLo +-'`7`"i_ekZ$h[<=()'YgTi~+Yc&>w<*Qv+;ܨ_`&`5mCÎ-z^Vn 43 H#d,x)NS/P$BRx acBA{'ci oIj)o䢡!<1od/؛ s㈂r{hNg^Z|T-E'#!δe&jy1e>w<?B [zD E[\qN. _1p}vnX/>K7읅Act|0{k^ߛeU)3oR*q[O|ڀ&TљhM@M}(hjĈD}V(I;X-uV֛ [}54Z Aۭq{gtS 5"66fYsKoNl"d1!ACjx(qO|eFCeNK0MY].ָ?bjҴH~jJDAf/笢F+x"g@Ovvb*_r'7cZWat).mu0o{esXnRmGKf ';[uOg &:$y.s3,E )6 +e:qAj)A~VAO`ȅSʹjrbEM@DN=q =n|h  6r%V0R-孽$]MWʉ0Zr:hv0SX2ؘ}8kt/rEƊ0 mZ&1C|{AYsg!YEXes)o)k+z}OW4oOlI8% ̻Joz{NTF *LVVjG7ѦOWitM/6%Cwfa- GPo 4C}i*~gT6=@NI^@0Aʁ&ak 2tBnͩm֬ {XjA#sxYSP➐ x8\1q: TI>P]B֐]yhrN^oP֞wkUQ$k9<^QǹQ_bC0 .YIgܤ#d1N]0~< Ho(:$M b`4@իM:f0.bZץ^upҋwknnl:< ieU 2hx2O&XXPgEIsSZ#) !q{tsn.YWzyx3hKOk⃲c=Xލe3{3?9-`zĿ2 "W꽍wH-5[@كN0vAip RN:Tc;|e8L&ׅ+{WqY*Vz]B(5 ò}_DKit5ԯw-b.q+ \/V.jf[OFvm ;'~0cv4[aZ |#e%CLK5;mq7EHyݖƬZO|sTZ%%)P<4h2k"[X$hlkWz7 |*i:/ xt%*/`EWwgi>!JD%_v-UIY!9h4\& @y0" ʅ|X5;w={j3pR۸MG:LY 䀘"_[NEkjt^eV}e^卢TUk3Jt#Y 21rfnZ\E ԕ%j0αPb<%/^jLxFך(ɻ@! ji)wПRKƶ[a+X-oTC[P[aiHo{*zOs MTPhҚ\5RT(Ǧ\\,@紇ΊCD3 :-Ku 'Z;[ߦHHCq:֧'H5W#>gzd~Y.b!pKVhy  :~caa1 "bFJ,}{o\-!KJ"cDr{m'~ɄďlE{GN8IqbMKJDR"K#2йŞaC"W GȲK SƗHbhBr/Fw|B>*T_jeMb PN~dyղ4.tyut;bG w ([4MJ\zB 4=-UYGcwmWxҍ½+ӏwe.ovӊsd a|fFExp^]N?OHN_}F#:Ax`˟--z].* C8RWw'> ZNH~lvr\7կa,[Ć^4=U_nlsO2ĻH:^覈zQ;%fI3I\E qGzgKq rJmʬzE[~ Iot+a{ ݄+bΔmq[+RvT'vS{~Gu@"n+M x[} -둠M[]TS6QީNSnSEŬl4a-xBX#X1pPH;OAacU},XNiÌd]7E\Ч!nue8bm5{MXbGԳb^PbF.eCnTRlIݝ]] XQܘwN&?녷̡<}_7tJq!/,5{/ր UH\Vpy}qTBZl+U;ҵV"P=0it@({9pS`V\csDH C!Mx#`̐pu1-i3i&Y. /Yj iu`Ѡz%*)q}E\'\S)V7W 3R|8D2(J5K}i2&cj8 Đw2C.ؓ+ "{tHt^ —]ؼͥk^l@2;D4\Z.pYo?<8DS tm(\Ơ/5L,/\x*3%1Yg0fVΪx;|al ? ޤJB6+25kG]]1z[G~aVZGE> F&ApZ^ZȠ=Cջie.9B],?8ۆ$  \) QkEI)- SHC%R.y8橬ǒ[83wՂKfChTXr긳9ZӈZ$*ۦ #X^IU]wΒHu7o"r}/X)RE0XPx氦nOoSkr|jВo7w45KBnr"i 1 b5ȧQgM.-W)>Lŋ,Z͝5`4 wTG\yp#<4\Jjݠom|bEt}ۑtt>sKv3Lߚ?%]9v9OCDf'R!lυ]XRyT4lxBe &\%BMŻ":wjr5G+3DO mo TۗBwwoZ$D,4KH02È 󇸟S\yz>jQ<{;/IV>x>j߸(akbQ=㗷Mnribp,ɫRjҠOmX)1/v pJآ 73SѐbL&GзS*A(V>y)jɉldalK_IU 1\o'##z&􋬘N_nCEdN⯱675_&d4;%+S):پBxK p `W:ޓ v󷍁kuO̐<}Z?H}{^P6<ߓA*ЬDҥ\ [*6y8SuQkF9$?wc`2BάHՎ0j#&.HANt9]rdu$. <]C1Y dydqϔU y[/]0LMDF[;KYÃ)_ (@W|:CV$#Zv W0XD:Qp?%_1hPYK~F, N~AaRVGB:zr v@b&WDZb߲ǧLEhdtjX/ a)6\ok׸ut(bB%LYrl5oMN?d9Pt_jNjUQ+ځ0OsmtS\|z)"|e6Jo`k °;p;f#eAIcZosZxN6NųFgDy(~DU q{I_GawQ: B򭒁/?F;CGW" [ )o JJv9݆3|nNtn鋖gQXEO1;@>@S= [bӜCsZ~3͊rvcU;lŷHՒ%>v(Q]T4. VHН(d ҥVR":ID30gP]rZ6 2=`|ip H(V}_!7J$ ƈ/7Y9j*L. WV,"|SL2% :m%@ 7)q=\hOӊPk[Lʺ/(E1CG`χ?;r*3;t`;i1~Eep&O(Wa8TÁ'f?gdfpOAGb29Ysգ+b=Y^˪\ǟwʪ_Q&n xۭ J+c*d4SI]3GV8D^c`X?6_JI9 *kB2w ;v#%emOΌ$KR''mp (8{ErWnpA|B  7tﲧ2 *7+9vvio3[spNi<ŐAm mmK)q}AN$Cz]CA3n;iHOB>&k$%M@:tiK@h;$9ϊKr FGf>#k_'2Okt|hJ^%1?l,r_CvEÎs텫}C+l`HURZ~*ҵT=m@8My$f'VHe:mD/{W%nU''}Hzt%oLߛ<01lzHED]!ԣ HPἨm7*VďȐb(nH$\ϿܧD wI2S*֑0;zgP<Λ*birJ\xw,i!1D,3X̚Hy;"qӗ4 ab:.t`ܥ$5G?l,o6vfB;sjZr]klo 6h>3tz)a[7!T"t{;X74XQ;Z?V!x잃"*9ctw.D<P=F>y+^fnpX#, g̒MRw320B&0i %#jlB'YBeO_ Q,dc&]l _xNLgF" tY;hpSh5 ޛ 0I; =.{I: }Z#?2ٸX&gM?sM(}4cPQiud&VU7kzw[ol=B5O*kyW'KL:]<:~VV=AЕ!OE@KX>踷KMtRvR?L&kܑ.rΖ\|ZbzNc'ݑtF A!5L1-̛~Z:<qQGÈd6H]}Ǘʭډ5c.,,; zʠA>$Պ ?((ʶtC @fԠ^°ϦX c1[^AUX*+3W&=9-՞endstream endobj 735 0 obj << /Filter /FlateDecode /Length1 1978 /Length2 6331 /Length3 0 /Length 7520 >> stream xڍ46nMJ-A=kR*"jUtPժڣFk[/o|9zu}?)ۣ`($F$ ꙚJ@1a PA~d\7ah8 )*`95kB=$!@( @  QH* wt` %]ah8A0N0WlF(0AA0B9a0n2""WaQO 8a0C0@ L `ś04 %p( Dlr. e@70O??!P( #p `+ H ;! e#+<(#~Heu*xO Amu.H77p#~t1C=aZjM@ PJ `>P'M}`?A?h?7+wa< ^0 ࿈ á$a0p;{ ϯeB"|/ޯ/TTP>?!0@HTL$ GҀ(/P^>3裰 ^ 5 b-Hys q#|`] =v5kjz0{ja PF:"1P%`#H!9nx` Lͨl(XA!d@p?v=a>? "Da.: MB%/$?HѸ@ $ ѻ@R?H gxD"H bIc@.6;ccBQlce0?:&bD`j~ wOH[_"!9NnN0_Xv/ja+iAŹ]ںa_k$怹`A_[V%E/İJ=QEbҿ@X㿚j䁀x8e;VŖgThlᘟo v?[`>0( *\Z\-'*NٹObl*w'o~}hGa ATpXyN= );PGm1RGi91.Zf& DEBIG $LJoˋz ;f4@|D{E/5yUC:أ˷qJ2T^GҦf4HǢ-Xd7$1i1ݐiXm C(ޙܭb1`k5diWG JPmK f!@,"ay)y@s0JW+jJ6ދVBX{T/ݭaKְ@C;B w8uȮ}F~QJp|euY0KYM:GY]zT~Scc[5A ?(F&[ M8eZ M5!*Z1dN,_1Mv/,]I߽GU/8n:̼yfXp-}y ]Znͦ~HӮ8tU} w+OK(J)ŸT\>~G4- ~K*>b`uMa3; |ԋugŨ*ݑ $ijWXRH;l]嚫 u1@S<bfkyO?n`V\F@X݆{JB |,nT׭:E{qۂ˗a8jD+|"B1Hٮ{YM8=31w_?DGwk2n@qR^qT H^̔mLjj$m-sR%^קKi^ߜr.5?Q]K &.,aMcF.Ae jSjtK㘒\OX@ MS8AG\ǵ!̩QX:Jl|Oa-';d/i|iG$?i1L z[d?3Rǝ$o9wx?SZ8aKuonb.`R@:uoOHg=ӌ#.J)uQj)% 6/Eo6sI<;)S5vHjHҪ_!>L4ܤhOdz/3Iԡecx}YL/_F-7b`}CO<퐹{,]Mx,7!?ŧ1*L~R5] 2 <~> r RO'قOo9dwFuGcEϢ` d/#Xva _,q-@vGL׵R8؏V>6wCWucv7mT7'jV1L8C棫O??t٨ 5gh s}GGi/J~u =F,e;htRԹnfɺU]kᕂL*d #K;QZI?6vIVV$v%ϙFqT#.tκL)km*`A~65_E M.4x;s4T$ɵޒ7maC)uImrU9KZ-^G4WI7Ut-Ihj|3tSVPˠ_g!OX Yr0O}╸.A^z5† ^=zcJu #Gr6BD8~=3.sӲ`cngsCmo">\Uzf$]z2Zeg3kw5&"}5:;֚;*еjV9_|;~OA\6֊tkƋe SLX(R(TJ4'vxݲa09go.񯜝<﷼Z &U.-ɵɨso.mua.eY7X n<:4-Zv<0%>ʱ&aS=}dֹO8q(-މD>򵒰T[3{&__*\gиt-Sq{St^C6=gPa8HOb$vkH;޳i;5٭qIgjnAz|}3 gp3,fj0AIt dkVJ 8)Dn,cDq{k=8+2sE=k'^|.C!S}dGny܄_gl&8|Đ]Rug,f}MJ:1㰖Ԋ^a׉dYrz9P'! ]_ {kff)NKp8bIS(p89B _ NyWS3m;3דNl oMNR@d&! pk^|U1914=_ܰ,0V:|>A`@?L%3'`iI+ߴqV]ŤJG=nAR(䞟ڍ}!*ac;N`= E`R#']HUˋET?rCC=.q8AMI; \֯ Ej4aeS奲qț>GxԐ?؅ x6ER%]j5E2kPL̗"nx+Dn1-]'mQi9|:w^S&fn  ի|ֿXhj wi'8$9<ar`%w"0pnI7baoR[ AccO$d\IwV>rKl^m=9&X3U%DeC [yb m4'B9w=;EpW\lBs,Dg,'?agi|9hٕ:\<ۧ5G+te=-CGM"v6ϛE=ډ)o=}Ղ|Z@{eE򎶝XE,MmϮi"ڻrBtwdLk+^O jTzk[|(JƯhB8 y27k}<}~UL)?47b=kU\S&/a4CnHK_L#V9I77ZG e"0sz(Py˦^@2<@uXyc4^ -r/D_nXB g{Dg MPIfQLk>g;v!vi+)NC# Uϓ}D ^Huq 2o_z|&>3S]X,=#BŰBp|%j<96R)[ m}z=^n΅VT~Ztt>u1-CK[n1 =b!0BL%9_%4e~fp+VytsOS;’FIe]c{R wNG'_t(˿͡Ǫs/iƧAvǯ"{Z̢lg}S}j!.;i26>4D+c AtRɿƹЁߨe?r  ~!4C%dsB^h9ioMy*V~J5C1#v9ݘԺd|7#>w[z?Pj/J5odbM*Qw0%-Ǭ!Rv$+þ?Y͌x.JP}Rm֊歪Wq΋CS$ ь1x\WX]l>9 .b9x«>5&AaG^%0m?wp.srѼuOsLv؉=Vn@fLSJشOg'Er@*2A+s3%Y`vڔD2y:FGZ fq\۔)h)nZa#y;].OV)#|{gLvy3OQ pi.&+rpHy.I޽]CJqs.G!*4$ӼsSm6´w&E&6>oQl׌M?jX =?pm̧_ft)1ӣ>vv }0 [W!ڈQqSsfŷ(UW];wۗB 1u3༾wz(Hrgg~f[VncbS)'.ۃk_|ޕdiyDVde.oC!so,'|9OF* ̛1&V\C-ŗdj&/ܧrC뺬]*S._ ,ϠT_\ M69OxJ_nw tDCǠUfWXbTbSc; 5Z'| }j$YOȉ9=q,͂Pg?&! ڠ8㷎U Pꌘ N%Ԡ̫G4o8ڤg&\E.ϙ)/Ϻ{)i6-U_>G$1215WVcd:`.pf˜kB3me%.b6ɕW)৞_*A\ clm#6?'_x&lrKk>wt܉@&? +WLgrGCL Yv:ou&O6z얃Ly !lupiTH WAF 'lz2cU@I슷{KcŚ^snAIP#|?r6 +Y6O^2/?OLϸ]A4IqS< `` F{Ƙ~*ĮZF> stream xWn6}W)[E M@qwE˵J.ӯJZ)F+jΙ3VZ1+poU4~T9`"[Ʉ CWͤ&5^VIOWǔz,9\933~x*6̉opcs<3㙄#a[F WF"aa͸b g`Xe&` fIϸ+kYY9-#n- Fϖ#x&gKx;Ck9{A<{5TA֌ h@heB a TXH/45bw #xzϖbxZ~\:/3N$ I( w+94vp0?.L:CR5'R8<+(긤b"5liP.)N ZLuJpX: t xPz,jKzO4S 0aaPHqMQĂg> <v 3_&pMYk/[v_Pte]]K]ݰ_5{jXzh}bWo ˦Nwp!JҤi84R6dCwWo '}XJ# 4W1rB´4(#;CSnB"@̈U&"au6ljߜ0W$W}-wW tRE<+c&]WFB4GOcih83%]رݐ McS.V)G\ea#nwch > uBw;YhVإ܉5>.*7) xĀ {ܤud|j2&Db2w0~"y7~Ț(Yh8~ۖIϣW?'CŒ7.BqWnTɗ^iI{2h= Dꈨ7'D'#y{0b¸oCJ <;-:n۳]*.KB%~pIx_ڡjX $?t:!1ж4~9O<® ̓SQ*endstream endobj 830 0 obj << /BBox [ 0 0 504 504 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/home/renaud/Documents/projects/NMF/pkg/vignettes/figure/NMF-vignette-errorplot1.pdf) /PTEX.InfoDict 513 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 517 0 R >> /ExtGState << >> /Font << /F1 514 0 R /F2 515 0 R /F3 516 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 728 >> stream xUMS0W19J>8”NiL!;%Mweɱ†< 6F6[>O շJ>j%AJX-M;(!w@e0h r0֠yk\^C^d.qڕ.'ǫ=U=1c5c8r:;5 =j ]Ϗpz]819+ǖ7ϛr5yAqέ!2۷Yy=`:-vx?GUJq@~<ϔq`QB/ UCmVjϻÕr Yol̽ڸJmj_ram5*fʑd6ԆjCjn QksCԎP<$5҇FԮzendstream endobj 831 0 obj << /BBox [ 0 0 504 504 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/home/renaud/Documents/projects/NMF/pkg/vignettes/figure/NMF-vignette-errorplot2.pdf) /PTEX.InfoDict 519 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 523 0 R >> /ExtGState << >> /Font << /F1 520 0 R /F2 521 0 R /F3 522 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 2108 >> stream xZMo ϯ|"/A ] a$22֒>zmɎUUX#۴Xhyqyc)#ļr^2xIB_:|_/?\b1.?߶oK\hy!_X~:r+[Ro gÆj lj(4<6έZOn,wZ}~5#w,B0,u z\gßtSI![l%$ڱ)COoK(Ef0' jS'z n,F4>n6npO̡nOgnͷw;Sf .#c*rT&䎏|a>=4N>wyY>5DWs )\|)A"˖?l$M#d{ܗ?r}w2ϯLrݳߖO4|g3ueH.޽:]YͿ-2?:~zR"$tj%U5GgJgK]`M*]-.Qy֢C` */S^lNy֜r7e7_b?As*!UGcoyD~Dz{l/ Mkۉ~JGz~qzF_9${7&E٨}Q\6۬LYLߛ}yj}@ޤ> mJ*ߠ4&7M⟠) 2zܲendstream endobj 832 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 833 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 834 0 obj << /BBox [ 0 0 1008 504 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/home/renaud/Documents/projects/NMF/pkg/vignettes/figure/NMF-vignette-heatmap_coef_basis_inc.pdf) /PTEX.InfoDict 528 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 531 0 R >> /ExtGState << >> /Font << /F2 529 0 R /F3 530 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 5509 >> stream x]ۯ&m߿{letv& h,ҍ mEԕԈ3G_a}H8G? Ͽǯûyǃo=ݿq<~|}O6&q{:EwধM'.h ް{6X `?=t|ZOٌ.>U${{̝GԆ 8?ꧏ]~O޸vߛ3cp ;Ku$¯OG|Fh|Q~%53B; Ƨ?B{КOx{nBkt ?ğ( ?}~%d`|Jh|~_ O:ۧq_O:J_':<:?g_'>Ñ BzZ`B;8:_>_=aLo tu+:?g _a:)epB'7a89KПOxk!g|J|5?ğN?B_&¬  3BC '>[&J{&PSBG s=T?%dW[B ʧWHgJ:2(O ֔_?|;UWG ^`Vw>Olc+!WP01}n@G)k :݀qZALm,5a=f@J/ k k~JKJAۢCrK*;t^BM[S%_ S `J&c4 0@(Z8j;kۢC#`{,Q2ì0^y[ba[ ߏ`BTl=8}/lYBYF ۄ甩QK+.CBoyAb}AùƫC`5_*~{i* fT@Ww^W(_C֐?ÚވB= z7D+D7J3 d)_[m *x^r1!rFbL4$8h UƨYɳnyavҗeJE9y>%/kdꡎX'om'OK,_s'mrko-̺[3nͬK5.̺$o[-׆۲k.6Wk}u޶ZwϺTZ3hͬK5.q̺Y2ےeͬK5.A&[uS#@iN=knm=٬֖߮uUVCNլE)[XbҸEi66ϛ:Vbh^m4 )#cG'8Fİ} xAİʆ('cئiL2tL{3f]1NÎftA̻xv0o^1/W|[Ac5]1gIv;&)E,Ǥ"Y7 ,<~1̕1Lc-zoarߦo~9Gsc)Nr̭y:f9֗:Fs#_Di-;Fsew7]}1n$ڣU*򾓤18i-X;FsyF1m{Hcnq1Ҙ[w4gK #>uc.#mX?yn1˜[lw09r<&s↑9X?#&x㨕湐gl~1˜[X44< a̭.Bu0V(:Fs #sYsW^]% s}q n6jp&˽,|ژ3ϟ矾#]ҸcYqrʐ0 wD1$eHޚ>'(D`lfz TQc WQ_p ZqcJ0 v: %u`"!z@J0 v:e8{ cc=P8eHe:R ?RD14K|)CA*Q(pOS N0g;.Q( u Fգf43 FHO!Atm9=ma!R gWTQ/\"S@LQmˤ cnK9ma"\Id FQ Fg^ R F!dL:\ J!CܖO(LlNAEJ0ʐ v:`yQNOD1H0 v:`)|DQDh_,s Z˧B$p9vB$:.)hi1C$8Ht;f!P :ah9eH@זI rA%H ;f;jQa$2-Me-2$H ;&+SD1Ǡ,J1ʐ\LP@)I0 g8$fe2$p:Dr J!}(DbbrF!Gp)(?&A)C1uwHL Q1BA ܍B$;Lcc[9 VќCQqLA !A2 Q2$-m%(D<9%^7c2$c:eH\cJ JRUTRİcґ[DUzi v&~t0pq6֊`xгi`{ (^$N]]kTͽKxȭ{YoES2ARQ&_MXYȭ>XQ=ȯWf]ٜPA3 uk OL`*>aTԕe}k t?o~*2܈ ){X*@Gx,GEADA냧V@Os*J4p"Kf+?}0)֏9x7|A-E{?|an9b܎5pH}4֔,O ]M3M*&O|)ٵ {6%X-n+Iͮ&kO&QqX&MpNoN`5a=٤Ա/!@ړԦI_L&Y rWxn2ɘ82,řl=9&rVmknkk'?Ew6^mqN^Jj5`kRO=xMMc5Dk8BtOLƆ>ow3&s^}1%oz(.b9Jr<*q٤-Ir$&qymWwr=4[N&$n-p˞ĭnٍe+Xk;=n vUMA[v$n)p^ĭ$nمkucdseB%`*r]0#W7mhYL+')B~Ϊ g/YWo(լ_pV"pVY RᬤsMe.ޘlufl꘍Y .ުYQ8c6 g5Xg1:fpVÈE|:fpVl꘍Yc">YQ8c6 g5Xgq1:fpVHE|V:fpVl꘍Y #[$wFᬎ(0bcl꘍YQ8abuQ8c6 g5XnqV1:fpVHV7?:fpVl꘍Y #sTQ8c6 g54ϭn^vFᬎ(1*F,VchᬄlLŇW\[[׾ju}Wy&(_?w}{ջsendstream endobj 835 0 obj << /Filter /FlateDecode /Length 1797 >> stream xю6^Y-Mч>GxVzWGRb;Yww]>$$")"WAz3(L8bȃ>{> "XbA"re)ٟc Ib&s4@řt4q [>3t91# `L̩]ڼlX({؏ =|yZUe}x<=ū;ZS Dل\ Hv$4kMy@ e -\PD,4TJݳIbsvYר*^륕^=^iz5wB{F_Uڍͺ0Q߶][Ci" V]xT|?*Jَ 8Ks WǶS&(9jY`#,6kF1]Ik,9W}Sfot}Q;T). X'PjcV g癷=41* WbwTƱK]cuҴni<5xB(-^F6\|K,wԌ.+XQd;_H7y+[y]D"Fk;T a.=QU4 ѰѶѢpT' D&IF)ilMK[*X-GDrNǣD)v9X10 TyƓbpA4rJ|7 XHn Qgne\{7OnD3$Fs,??Τ'sz0m@C*8ZÛs׺7!ȶ芚oHX݃ Œ`l00Taҷo1 Y1v ~~V!1R Kxن CweacJ1ܻWr۳&<&>+vRE$0e5OG$Oߗ; 4W%Ewd8';20<%c.Qq̒(;z;`Sh 9Rt/zќG`o/6w3>EOPM RƗ6IT꜓ v^IKcd[7P9U tU[;izYcA;k9SE6-[endstream endobj 836 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 837 0 obj << /Filter /FlateDecode /Length 2264 >> stream x]sݿ35c HГm6\۫s/DB2s_]DIvm]sXrh0 h>RAJҘ4`4"i 2΃tUfmQWiݻڴtm1h,eZhoG/Sm;kes4w?\\Mx,,! $NYB!Dޏ#]ڑ4wzK?DD2?,~ zinog( XB $$g8ȔUP`z'q4)Hi4rH|VY4VEB u x۱2z| 3|LClM_pPzbAsPI!8Nv[@GBY;"1$sC:kW KVJ\3h5vœaѦwJ5L;y[@tKHUH^ߦZ(gL˪([$ B8EGQ:]U5(bG ENҔmsiPL?[ߓd6pMeYFy4a{ !8vC}bl럿;>M(؋l' Ʋ =iyoC?4]MPEx ?y@X`̔]/ڈrb]'4gt ǜȳ#*4\-yc eבmuذaǽ爅d{ kDVaƴW$ߏ$D]3br~(YS`N8 ]ڧ[/B; YOB`=B“t8byGC}D1=bjWp'j3[0"_Q1q{D_cW`#jcA|XGx] x^-}bn #9#a[dBXw|#C @NMTm˗6~%8 ctLDqB9D,bo؉ׇ|ăS xer7/g[?͏sdG|m=sE=ʟ}Tf~y/L$6ϧFc)ůb<[=)cDiu1o_c0~Jk>t;_KQ7,雄i,xJ)M9UbdTZwR΋e>QY8~0l^FQ{GFW>6_y.G;EQDUcjMiיzٸ>1'mn!\<&#s\0'X* UڛZ1Y`aq' PDt.FIW3իyF_./kw2bn0i[D]vJFㄥ_ܣo~ք" e}8js|cN1+ boFa= 7%o 6\WZ,N KQ-C1> stream xY_o6ϧ%2k lbM; hvȖ'mO#r,%1!"Q#Ȼx&!DW5~כH]7*T VO4! dJFd(% 遥GL*`$1 *~*[.cX yD脓@"XEOʂoH&f9EQtz1<50R&fg?['SpT^>8N\њCJC%*=n%8A;"obDXCNQE͵۔L@,g,I쒮6YTMJ.ͧ}]ڵb,>M^jb|)i־nG'4Z9 YRwc`zٝ: 6@F#J]pǻ7 $N7߲O?v|r}D#vSh"lj>Pm *mni莢Ov2 }%!j3}WY'7XƳOMdBmT'KLGc$LG#jbQJFctDܾN<_LTW(7(vӫMJuI<e(iA' -98-t H6-q |2Cb/`ɐK"+`HAsnlC^GG©29glG!ǝc\"HnTHeS;šxE1ĸ% bjZusk4|$+$ULt(:xQگja*R.ؠ.x)Q%xb.!lS $m61\"jo_تѮ𑖳tvGύ$^.4KBR9l;5v,H AYFҢ49Iˀ$v1|5{;uEZl!)\.3RV-UnZYȩy4@ęi>N>r]]F Lo]kz@ܐ./g|cߔKٟx=viS\Kjn;߳ t" l]/t0h6pwu@fME^`mgW e4BvFѮ6H^Lsd\IZT˳VmdȨm$¯7˭L7q;Öϋnˀ5y=!"UܕI!ŝa$uuLeXa_)H{endstream endobj 839 0 obj << /Filter /FlateDecode /Length 2691 >> stream x]oܸݿB@(0.$K{I^qתFqpZvΥ=x$g'g^Ixgk/40QY[~0]-Jye0Qꛪ-],-奔YӀl//3Iĸ-`B[_4PWeQֳvzc/g]zki/Ż@ҥAX ӚuӚG0BEFMm |砜'@֒CQ,TQa8%G]ClB*cMӂNDZ{kh W$.*f)dd29O{DZKkz?/%lZݛ"X,T۲άs5l%: v+B z2A.!?\^k=T=ZRƾKwzmA;F&.b톞"Ȅf~iXk0ۡKP~a9Cܔ:C;frS_SQ Skv}aGo\%ޒ :B3ܴmR\snWVO֑e،UCF%/΃ -M wn#H"[oX2-C~s]wJmȚX1 iʴ^6NoTD]_|mGd}{;wю/Uwc(u;Ks]DJt2pAO7oC @EfZf"y$gTxa$&VIkUXLSE^hk`Sr 2ê* k|SpY JU"y琝ƃ޴~Dw>+eՈr]wjđQ8BSa;lj:zp'A.Tqu&mc`,2ؠm\uckNG[TR̩Z!0X1-AdF݌2ziE @SzSLgԧ5^<ñ-cSc ΐddlLlM"`.Fy-i3a ) [To&8GʊQ`YO*HXD KvrYVtdxV< D& -)õgg7n7ۂ> stream xko6{~ )`+vm-ȶm0%W[w~LJdKN<lj'[ #긖yn',x^bnx-/f-b>„X!Z@;@,FV!kMzS_V]*q@|~zp,D؞u[ [>aPEևA6Hgm5w0a#[6&@ȵǟDXJg<~UYE$!5֮n ^ Q*^;eR<|).d;O>z,@AqkٽpD1<<(Ñ D4$W8R4FRhoIuAt?+|b@y^H2J\7l"*ɨN  zɵ !5 ~P4E^@Km(II>=q)̷8Qup ɐ9 J1 ?D" MLOM!eyi(d!Pɩ,]&d5]"e5/Aq)U W#JGkijHU]6ƁrC=Wd@s( NgPDJvK~yvy>$;aEVUB|Z}eu \aozIHOK//Qh۷/OW 4%aX莅}x6ћKM p}f4wh7[3R MxDV}١hl1F,0rQ](OVۨ^T4O2#0A>H̕45A'әTEɔr`%PX$DVJAu2 ޚMcb3ʴ[ӳ95jD̵+]j`Tɟ/ww i'X"_TA,ZtF ]'FwLG_{d'@{!r%u|\ict&壼5N, 5>BEML/v$xڳM*~;gu))k'/`iʗ5?b*IЫhdKftwrζޛYD(]0oK]ةV\~{E^)]por7_VXֽU&X-am|+0AF6[:qCf>lNx=74rkɻ6q0-*jGD/!wK?my|h#k^i=m/an ,WT,+I}_5P{ "Qhx gip>,ޡ3u/Nv <ƣuV ƈ٤=Svn1 Aއ"әG,sNkjRXLvRʄL7Ȥ8+ C 6H,s|eFԨ!!("̨Mʌj)~-c17uh`'vR?M- {Mv{`Lr5En'w;0P7&̆䦪ZO1lo'5TK}s|%!z<[C^.^]Bob[kH|Kuр֙p"&<.%&ET\¬Qz6BW'Nendstream endobj 841 0 obj << /Filter /FlateDecode /Length 1594 >> stream xnF_A$/T%$z9m q5وBR9=(jI;iaX\g9wvg0bs(wx;Ɂzȏ_ `8a0!DuD9 QPĈSJgv˭Vr Љ;̉ os>|8/ܥ(E&kYVأ[b!LuQ>!xt1 ?&E`1S6j{go l1ǐEa,D!J$KvU`y żo Wzz-ExXW0> stream xYY~_!l,샗_M ְ7=Fl?PbKC,%jIjf*6I: GWW3g`7>U0Flgq~`&fIBB|D Z&~'3~Ymf[riZӛf庪L,MI|{MJ/(>T6kyžf}eP@(j;<n4'jG4dMo46eJfsNK ;RyM#A~$emoWhLLPi52$,P/Kzaa|$5j@wʒVَhYT≨[q~s,bk`?2U^}2(BNA Z TF (]H{wEFfej&VR kV.?]F~:W\ 8p,c!7-8t¿ "eOe$hlgHp H'(ס( pdAXև݊ g5bRҏcw=dcUj{ۢL4Jc1dv,eNCmњqX jǣDHzl5yHpnxn+XTuа^*c?g1gGYB%!'P!2TU]Lg7gi_ӨT_k`bTsd&~Ԛut `T80xXtg?28r‹(]nb12v;,cbO ceXŲm;vLNN7EYq?)s7_, azF(Ѵ6,cRG@$A"I@$Ѝm&cCIyԵ6*?nc R? dz >Á`B49IYƮ!:JL{c\4fdž5\T,DɩA+u_tP1ہ<opw  0 S>,,WYHg΅MJ) T[]iV0/GEC̰ xڂ? ; 3:,`[r(d:t!RtZ J̉)4h찠E |P>}i!TS-z9!ƫ>jTsz` 7Ub؀ {u^PRP:PʩÏ~;!btx@ ?3ڹHCO< >|ׅ[2o=A8Wҏꂌdޓ1籕umжV-~j `A-cX eq(Ut654KDoU -!ċ0_\-)#yxas E9PXBxy--@]~Gt!G7dUɝR!߸: ;$~u䄸5McBSm]^* dŶs66 Q=װ-]i|%Sh,g>[oa P5l(jZw6 ..n._-#%8>hrZ#)lbP+V6׀ TK'f% VQ8͞sZGҺi^dM$ bp|dN]:eZ@vԢѩth8@vuCN]yl |\;{or2bΉ Jt^B9WVnߺ!~\bh.8]6mWZ}x _ww]TnYǞ-)󡓭 \?w;C;/NҤ?1дvgql3OCʗ$P7W92endstream endobj 843 0 obj << /Filter /FlateDecode /Length 717 >> stream xW[o0~ﯰ6zNR!$.+ JybF 'S]u현r:|s49w g`t.!! e$> dnϪj-l-62"2M\kI:) f󬕅*S2ߴ24J 3Q-mlL@zK,Js`W([G-` u.D{-<y>`x.D)t(A6hzL%A4t7).u)msN[p~v]!mi~ ֙c9=0G\XYU ̺Yi/͵X328qRRɰS|65.Wv\hΫއ:3i\gS\L5O!q-CD^tRBZ郵TTYB|n4ɯ[Ipko~r_@:C"r;-d a:ZT1w} yEPuz)HS™H桑qeGWʵ5^XH5+*wG(gM* a)@=S~#й3Fg te/P;-!Ջ7&U eQ!֢CQy''A21$̇sN(1.u*^1endstream endobj 844 0 obj << /Filter /FlateDecode /Length 3534 >> stream xڭZYs8~PUBx{+%_gc+935LM,qLۍ)R;'h4Frot82zA }op9|-*$φxiv|0wȗ>2~l)X(1E&l-v8)5WCZ*+a"/㛬TA[9J.\;6DYi9F'tBDQ}wMvw&^dnmKxm{?C6SsFc2t?/8~??M٧;E5A>azxrz17_o1Z.OϾq(bN?v@$AEƗߒ@_%Ǘ`,9QiOwӗ0Љb|qHFtqp^;$K+8 qf;K7eUA0@7YR5!??;y bpX7[-I&HyyqPe(&0.")ZJUd XyZ̩!ӏ,,%j w lbUs5nNS?WR#D&숫TlRs檢nҲCs UmI-U\ Z] vU?(<@[7<$E+U0yWrۓpIJbNJT đ#N6x̷přkf o,E-Zn1)]vtJ2AѦJ昍ӇhF`"G] bz\K<**iNZb<8iY^U݊G5W仺,v$D&Z*_Pt3΂gdS5N xWjH==$8wzG1>ɭV(;k²Y7^hsFk>60<Ⱥ3ox SC["/j*m"x݇L“8MWHt#6w#i͆ /*8jdy)M n1,{$G.i@rrЋ55r'O֏&$g7\m]GcMv23,T`D*XC`B{[| [lw-Rp2> BbԬŢ4wk4nh'q}; Z'+_d J:s^f"2&dLD4b7L1jxyp க:ZS&ނ`O4d07$ȼyLB"+vɯIp=NpCgO&̂F֨5" kbk63юmO2QE;h6 :|?f"^ Yu.:\/@ڕaV4<ҚKP Zo&*m9b$<س6% eBigZř7%_ƀp݉O4x4h"%xe<ǭJ}^& QBSZ c_88~KzOIʲ'bR4ODH nN5MVt+%KБhZIF~$[e}tYo˂W*F/stG3@ŃdDUEUoY ]#9,ֳ~]cp {_j[pBfi uӖ4]*Rt֠A'c?6qT/龇]#\̂[?Q\!A*4IZO2>>Zu"B@?ʹnu I6YyR#22#&/ y:IFS. r"ۺߛup:7Un157UM##)fUdf>in9 U%:4v5) n<&Dq݊~b4ޯOl}fUc(ϺtxBx B0H0ۅVf Ǘ W0d˹#ɝ'\X H¤$x%&V8:f"]Q#|W{@+zlp}:ͨs4n є-TZD{ \FG@D GݧL>̜0PK zqU mAVFVd+|k%, 殺VePA>讣][$:/ K\\pF.dqC-( q:?.R&0&RfW&_̅RR!ចN"b6Dw5LA2S`*B! xLq:DǗ{endstream endobj 845 0 obj << /Filter /FlateDecode /Length 3945 >> stream x[s85pT_-c♔ڭ}%ZbBZ~$aFEy㻺-W@@?~ng3ww³EݝEE!?3B2?gVgy}j6]nf"sq'">K,95=fv[䕣 7uSF߹TtgiBvqp4uRʄzτϔ朳H*xy~W"ngsu9^IƻuQQu|??7iaT7.p4^MU`q8ԋ..)ĵd" ~/|_v;D\ʀh /}jold uy8??p֖~FnRzIzdXuR&IUvU$,>ɧU1KElqyU}/LRJe7J$aڝh1ڭE,58$3i& wB E*H*elCgsl <薙z lGN-8XmR]`!#c9 s yUqa=Y(^=7nҵc{[΀pJ5]4O3:=lڸ_utL&0Lq.ܔ 4a>;bqA7!!;8ɨ+z.U3i_Vy6RPm:+7CMt<cߣ$F\px?㼂IpZϝmAY;BL6j +*lVҼ́tS $LȌV% ^bM'f"% ; ` *_S*dڹҪG8(חvD$AFc\Dߘ0a:k<[`[̋WYx(d]_aPB4OvtVW[F] ?}-0_ަloH7T0л3(P[7WtI\e3pB36v:~BtBxObPCgi.,'z 0L/RC%`#:P5\NhR:sطt9B& _5 9hH2#jG`ILJj8~ Bp_AnY'".aKZ_~_M(x0w@AK6qNX5@Ir  (@ z0E,,.>Mr[ VQuVb#{ޠ7R4 ի]\VJȏ0S Cbtpi[z}KwB 2VD3;<U[LɡF~M`\F FF1\qOF2 b"R \{6:j pqmI[]4$`HJuO^JVE/ =Kd[t];Wp'\Q7( X<e%"Ǖu * /}|JZ@27'MRM¨*}mP3 iڬJ<؞VSjjB)UtBO pVָo BKڹAx8 ྞAxӁ(yꂪ[N|r?.u2CqzŽ":dZ&8&9\``g ]+~xS~rCH`fHT(/,"@Rz'R؝Ċ|ՠP=¡WnUYP AA\&D]%$Y&BP]ٔcȊ5kP84DO2W L'px7hp0"I3T\fYh@σQ7,b0n#?X_jPCu}k_׶a\ Ӽz!P7]ӢkwCGWE~߈֕2ݽV7~n 8p t8b BlGt.Ή ~+Hx;]g-ʕ4ubT٫szNL苞2 Iv .[ ql[z|$TThFFC#@ 'kYOʵ\#1G.b9KΦ5Jq}D N(bCML-zlj"n7F"є;[]ej{ksw/i퓒Q[J7dG=U+@w[Na8?5^ܻj],ckqc3ags, Z ц\ k{ ܎fa9{]L+q^lJ m  rq_ca^*CX@V`\/>jHZ|h0u73OfYVD bڻAOH%Yl"bS{D6dyb6,AsK9D tco+"ӷ u 3jpb`w6ם˿dQ{]Sab/7#!{}FS;-& mN~85%Ն9)[ *#O *\mI꾪X7K ywC3Awix%;#ߵykTG])Ϳ8 }?~ti%O,6؏I@aآ~֨%pY<>ܝ$eJDk  =ⲽjzDI\[R0 O.K٨9w_]^` O3PږsAx=w֟+QCM$!J'q >&E:sMY5i=b)~XF-Qg@l=\!Bm}&0UO~^^_e`ax_ K.`k$ocA.wD]MڥSR(X.>$ױendstream endobj 846 0 obj << /Filter /FlateDecode /Length1 1523 /Length2 7474 /Length3 0 /Length 8476 >> stream xڍuTӶt.H䲻K*!H#-) H H/yw=gf\󛹗YGW (^~>@QKQ_@ <668 G"$AQtQ6%0ꖩD4ܝ~ ~Q  EDJp(@D.ޮp;{A=8 ~qqQyg+F({@ PJ!eBH|`g7> '`0(h66><6=> vn Np v㎀\5\`?Țxvw?%#~!  GlN0#M>F@Nnx% Po%) wA~JsgeT C~էwAn ~HOuw"OaJnMxPaH{yA쁿0vv2ߪuAloᶰ<_7 ruo!( O[3|;p/v_,n D8y&*i۫ xA~(@y_[u?GBu-_*n?mLYs0r^!_.I7OC;Ý;vAko1쏵ւAUGoEaw/n*p/T1I]mz'8tzxAݮv{an{}0v]2ZIaw;Hv*c%*|2Z2껔0 U~[JCY|F>q-LC}㧛/yɏgKb=%T՗ rC|$L8fF!jsi1$@g۹Dep>0iW-pҦ}T8>`ѪwTZVT4.Z;G>!$aq}_lS鳨:s|'˵Gb~5ϟ=: Lϥm̄-*z͘kW `{~ֻV|ba1BÑhh +# OS]T[L;oL}PM`BbESaE?ў>39/0V%[И߁)6yV3g |.枇k 40.ns|>!ȢFY$laB@SŬ>-B+2M] 1De@ sgJuz-A_o9Aa*S#Y-ac'<"xy:*i[\ڑ,O8d7Dd9sۻ aC"Lި?ݻb.e-H|t!=m|m&52 EAND.SU16lpp}sDjEuUU($6ϳ물]/kbF/bMyEpW;Bemߡ;Y<*?,KӃtYS_]MeZX]q G/]Ȭ5YSNk>3l _٬,g.x7G=wX]Jmh_l(utoÌ-ŤYV Ij.GLU3E+'~?yjI12von;dwdd{5j"-J ;\xF%Il(1,H"ZaHc KS`RipS|S\܄) W?nq`ʦW佧 Z Xa3N`Նl)'L= q9l"byZ{-t:>VX~C\딖= si$77ۊflS^XQلP|zPp=r.ˣ{Uqi50WiPӂBf74)'<312Љ`G֭70jN ѦƓJ{ ,rqzʲ.(8/=`|VsmBmxAiye AhHN5[~}_%2T#(A>p=i& lX4Rڱ\tp²ɒ‹Hlyzy\*ß<3 x4H>Z=T*uWǾ G͒Nf Syʽa;WJP|dc^ⶠmpV':fͺ2fQx/x@*K 4I}{е_l5rj+IAw(xqs2ku$r2hoNJ㐆Dq&J Z\AWZo[2+bFpoiSK.vFӭ:.Cyk L Sxdn楌; V#jmt:4/NUƮiƮ3&u*T6yM7?ۣY%l*̻Eei2^xw)biu1k/)iUz$gƸhi{St| Ru,A-{ ҙJu%չh+ , ^[Sdt6uY05p@ieNqT_F_bOL~ u˫2^IX)'F!itlXeL4<֋՟]gJr3Ȝ9-2lpT[bl ;y+T$46 g/oEqIE;o*|EFi&wGu$MnjLږ7 Oۧ"6//Y& 0_.?#9UfvHK 5}IP}Ch9hvi®c5)YZfLc}l϶e$)zPW@Mp:s)Ç̜<>,JJ^w*q:5-z+0ӗWn wsp~D V֤zP&0z@i)O9w:XL4$qCдw%y 8rc'U͓ ,KҰ<ؽ7~y tfZXk4! uAV Ergw-X_ =G%ަN'A8a"sO'O<=?XSCzr!\/T_\Й:G$A$m9\Sp_fx,4#C чPB}o-/Ł X4Ἰߍ_dΧ~zTi m緢u.,>1/=aS^XvtZeTQpAi{j*ksFLP#/^=iJFRam"߉7mn~ժFuⳫ;8G…, v'b!e~z Z&4J:˽:eMG爟0_iPw!g[6Wg8@o?u*=Q'g5vN˽ JVfa41Q94vV Sp& ]%_ο]%C,ܞK=mJ #ܟTNf9:v=Y~(WS%aPӇ$+@^Y20=5ӱꈠIDݯFntѴZq^SD7Mp1 * `cFjZ_ lT.NPX]x.Z:~P@WU33靎 .74\畺pΠv/Q&x<ΐ)#*༴Th6x阠Bxc&0jKZ.2z`[r!_( Kfb1 eBhrBõ HH3X )X<)4!&WKivs2a\+L&y<5YsxcsS9A7]8U!cD !ۜt t~*X=OWM}qc~^mngva^m~y/τ82|axrHUl~..bd٬<7gJտlj4尦ȥмNBJ9p@Hl7X3ѝ*mM/-ڍTd['N( 4}R>l|ȩ|LCOphܦz𐖌It[W(eަ`Nܙ)Pl2[MDw&Kl]mƊ U)xbZK/;2 @>oDms"X-O:ӪJ򾝘?( -朅"6v* e>1 m'= zu`U3 A[};Zx9$Dv<3lɜ4YWi'A}d-~nkx 퇑[z] 4m|6xb : Èrݷr_CNA cnj$^rW b˳hXHVɼzƦ|I8u" ȡI JZ& |- 8!KaMM3jy5.gȾ?w2,TMn[_֔Tk2;At w6GdZ[2nuP\U*G8r(-톣L*lvH ʗ폭 >)sNLĬ9|%Y1$Uw ˉJcR)I}2@k~y@7(qtcė:y8%3VcB@Rs}0  Xy} {v53on{rZfKH Bgb[砚bF' EvgBAwAo,6܇,H|Xiegxjc7e;0j-p)mX@_UMY6z7i ~ Kkbj#a':Mc#U.x@v3d O@d3n{i'R$y89ZkY8} Qrj ]dH7FMcFݔ8g74, 9~SpWt406y^aTokX\n*endstream endobj 847 0 obj << /Filter /FlateDecode /Length 2482 >> stream x]6}Ѿxo $AzMKI3zi6G3$n}%Ha\&OޤTiҗ/וLUfvSwKr[iq4O1rדt6&%AW_6LCx6DzrIW#%8&PFƦU!~6e瑐 'Zw\eU6΍wM]\JMۉDl2¥|( cҋμaURiaK^zTi'@Z b9Ymdapspl}'ngH"_+K}hUQ|TZvr*@P8JQڛΟJvybYQe\ XKG4Ŧdž- }u9+*7̏TsV3F 5 Ԑ?F"8S$ޫLN_I~dpݙD$.c\(˔Ulup-3ř]j}8gQy\6s}nOYcY3[qI "RF3zԀATv!pJZ|2*U[n7ї́Mbܠ̠u-K2. 6 1_dHX]lla#HH .g=ugUuEGP\Kp^o6/@÷ l3~$ܬُha\2J3@͍s#p ٝy6ʸg2pxY4ڿu#8WC@$e:&-3U9+{Ӈ"8B& AM"JCAgn-p90!xdܛLƝl #m_]7g{I|-﷘+_Yޯt+:%NcF/3ΊZMip3k 4Y}III=&c2{6˻Nmv+u'T xKyUI ?$l 3 tc(UA\#xc\ st SNΧ7W1CL|-1%tu>h7Wے_R#4L藾E>o0i<+1={ S{p8GjLeBQP*5zPl E#ʫoc[ZjfԸxBcՂŚD_{7ʫGٱhf/ 9vVPذb"_"z_medxfۿ.V*lu,@5mT5Z Bl8ĕ{l 0bǼր\8DRAAiMJiuiBLK+12X6ss%L.x2CrJVOgpxK( AL0fK2@䂨vP2'"VgvZ8^c T3:֯`_FrhA ~b]ҧ$l.wqP -G$iUbr"DiaeQ_Fq~|Fv6Q<]=M!- `ضU0 !42$̡'^endstream endobj 848 0 obj << /Filter /FlateDecode /Length 3096 >> stream xZY6~P틩* &.ʃeɸ*;I'R"uL4n?YMɏ|GO_i=R֪rPivr|әzZzIl6f:ӡemʢvI,@8?H(扮Jx1 z;KŬݲYH6uVf)_ Md:3O/N%!eo.^*"˰M穵^JY,n<-YJzTNMf![u:3 K澪-XT:As&*徜5\gEZ R놇uhK3cLoe YVyҦt]"zkzFKxJE8^Q+ άIRIam^ܦ?ڝ:Xҗ8C8 Df" D@=ĴRXg7oxl^i҆3Ar%&Xʗz'MJ?dUI|̔;/`]knTwҍ βbeUrG^"sK a%qDۊ,"yoao'8owy;@ocL]p8U<:a{ewtB!9KMlI]cQ`)*KaTxfQA¨lW ۺIsVчԅL~PJ6V*κi\ZDiq&ϊU'DS5Z;pZ8{CTVDqЃ.ҼpE9 DH޽`- R"=GHD#sƍ#6P8wja'6FW~Mؒn܁6"EpK h3{@ R иf~$ kjc`iC$LCۚ1mٟh ZwۑVp ;[&󦬲?5ikྡྷ,fbQd7VKy˶Ⰿݵ;,95(]gݻmGlO N~bSE5n_:GR:(ۇl?[1yLJ`Obxhpxlj  Q-kBYsΜ}olO}Ξ@3yžzS=XIP4>oH^GQ~OТ{RRb2x;O\ -/2"0=O*^263Y)\vw$p9,qsbeBsTczx v |*`߬3pO S balϊ0A9i b{iC\HF`5E< :AhʎK ;cCBWmA_eur',Dukl;ёg(8r8_aMAHuдAz%q C4S7-jR:IxO]Л'Ùz W3CAͨfxo6 é@_,?<η3!58n}W`κCݻ8 N?UEߨ:=3`\)킼fO8tq ߈3ad4<_{} lC~3xxovZ7O6F y4vnP3X`)0 ]sՑͳ]'MJy^kFU*C\W=҇] x% ڽ+9owi%d! ?@rm΄1Uҕ޾ClLS6EC'DG.gh!;.Apy[6n#:Ȟ\NaYG/:U wT=H}AeH (}Wu0`m7)gɺ7zD}[.Ա @BdiYJ'` e1[}`Ehk `ݐqzCI"m,.G' Cl4A9XsG+8KTpsh`s 'z !iΫl: "gQVb?tXW@[8_iJ}Iը5*?}c ?\V T07_#;lk''Y(8 [ hhaoPQendstream endobj 849 0 obj << /Filter /FlateDecode /Length 2957 >> stream xr8=_bh!ZjaB<8w݄|6 V2tUҖstX:gtɝ瓓ϔvRF~,%Hvb?2 T{%wpYQx eޜC)Lr{x"gRǺE)^/t(L!*nWfg /ݰidrO^{~kPXs[nŬ"܆"JUC+=Y'0e3SJOs@IPC7_2h sfkbheDBe 1ʛ!W6)bk|m9{ᅡlVfS;9fo \!Nk,i I,D`Ss^8&Pk%P $-'Lؼõm=_43ljD,YԌc֠qR"LX"35t( vD*H06DF5TX|ʼG%1}5`u,t0V"U^XlޔUB9Uՠ˼>e+ʢ\kaKTD\yvoUgdJE@5<[s(4𬭿06m+%ݬ:C&` _A:G׎Xȸ# .yI^vD&>癥̀ꛊG2b^FqkP hHAY'"NG8:GM9+D::^\oW$TAuklvd!+6h븣ۮDP.IoʵݒeBö6(ܺ0um'"iG]M ETuZh͒d>;.X<"9$E*᧽߈$ P06D4l5G"GbNPhQ0Jr4:; C|:Υ7N(SNK)]t(8uVl\r'_uRй! ` J9Ag-=t#CuTِک.ƚ ;cdbV9zEj8 cG ?ШȏkHC(g$}y@'4 |rSE`]F|C"p$GtxJj?(^s#: 4@^ YQ\r <kin򕭰#fięܩw~ Dw+0k"kGA5*®mʖ ˫c%h~<=~[9Ⴢ*W[;CYfEìC:a ޕ8C@wrIHOeQp͞@*NU<(Z5ie/VXA^ ͶCޣ!lY*-Bh"PBb,w_<`G$A6y0nl9\nӖ<(G@..H2^@x?ܞYK͑|cF ; Im ZABFkb:Dbq V d- 9 53aR*PZ<^͸˚RWWGSΙYM tLƅfQ=-l[8)瀝F~ wx-L:N0AN'BF80x,TةjSƟ97ڇdSR~& VNpA""$rG>$p(Lf,֞/24 q˶=ńtV)= -I_,ݫW޹,\o\S { yaj׷~4:L- RieK,'>ZDLVYuu=lg2yy?;>OV%hGj` n,fmG[{Woyq<ޡɽٗނi73euaz6L f[UfLmt>("k;sYUί{6j: Lswmu-U|Z6 JA`2C|Oh+4 ,XtX\QQ _ΛW EǼP[Sp>J^> ԐDu9~4GGЃyE5fQnK0uk(/\xnŎ?Svg~*$syA3xendstream endobj 850 0 obj << /Filter /FlateDecode /Length 2037 >> stream xZoF_ss0Xkr4\^qN\[=ED"IkIΒ"e5 q{fv>~k9g^s2ɀFȏ]7G6pb̲mw#fs#YaCD,⎱G18}Xb^¯wzmvtvXsߘ-2eVn2gV-ɯUX4Wە윇,cj,K%޻PE\9S~@i@gdz @p\ك.'<4c)r9A@Ģ*j./'CSf(LyQJ&}>pz BШ#|VEJsq[&^řH&J*vߘ8nے )ޠST`y`<`y +87|M9djk| Y&f|_O!Q33Vz8&&>ʗPqCCS(dM-)G겨DT &oZ [8N~$і7b%R6qQ($S P00q{ 1,5\7ÅTgOcwsnKh%2Kъe]TX@u +Z^@[(~_|ҰJG)68".`뙳 C^4J=[cPdv5pqOՎz- UqX1;F)] CMdjlTNRqIUԷxCdzN!aRQbI_TNC+R=7*!t>uժnr&!7s" ,rIHFz+%n'J`Z( Jp"LIn1$ROw KHK\플 2 R'礚]bng`G-*޴]ޥ-a < R6[hzXXT#0xdQ; !~pR';x$X XyR`INEHmbYSQlhy|e"C9;q R/kh7+\sNt7 ;0 cQWq~?oG Z[ Y]#`!O!9t19́c|ߌݺ2Fn] )p\4h5׸X7/gӇ?}y[?omnnV)WMmU ,fy)sʍHΡzR&[}[|۷5?&Di;_C:r2{Tkz1( %O ''sq9uF_z^'naU*cوE0w|t;T> ]Pvh>>a{~vg_=7}h^돲+"?a&<@Qĵ.P N 4g<}|z_0ݕ~Sc^Z]TLwH6FHi?#Wm?#g}|H^~l\n̳#fQd{fv;?endstream endobj 851 0 obj << /Filter /FlateDecode /Length 890 >> stream xZO0_aeZ?b'ևMH`<Åjmtm2ґD?.ggA0wu]VP󵂂 `)oHs!*q0* !8# B \#ɧaqZ&PC#@ ⤪j=p]?mPZ01MQV}ᄡ˪`c H\9Is{kN$݉] ݀/PpjVgM]hpߏ9vKl2ЀP#A_l1 L5ýsH[Z:x O:'&&wN B]dN#N7dWm U)a_ JW¾ v;Q ghE68/x^4p4aKиp4[GOųr|o W'& mߟe{_φZi$zfV^<ʋGy(/ţxUV P;vޑ_) ~뇻OXql>*=q6 A2,@R"c,XI'endstream endobj 852 0 obj << /Filter /FlateDecode /Length 3338 >> stream xkoEa ]>iE,[X w^{G(%R+; |FU07Ӿ|~,X gq%9A??SIR4V, WCB7]4\Ǯ} V/xxuuʂU2_mV?xo{ytzշZ)?ƿZE+U^yV:L8yz#ڡVeEiR x[UmsaDqc²AgJ5Aqk1BG"|:"kL[I6s11GY9Cr-Sݾ|>p~L< 7_CMƐϞyRb!@ X^LDfHz[ii;~Pf.];œq|5ݖ3f'oO>?0pi`V2Pz&\ф 3eah7܀aKFy#ytdؽV?^^ʲC{"n-h=&(#[H(HɓÄx#]n˛OD+yWjRESw!VJ=8AYcuus4i@ [yvI*Yvg$^8WQh=sᖐ4Q4WmyYVw6;FhUnzld`^#;Ka>1DA|ktFo~=IʓSǐ& )[[RۍUyD+9Q52ߺy3,+E\>,F@Bk9pkсhk.HΟ7{ шh7mRajzdxH@!qJ ]EAa!'FvA` 8}LӐlO%TKdn@ X÷ujK BzWEK ϱ-DgA`#u!" b[UfA 2e r,!_26CYڀ\v }K/4N!\5<(򺰌jƧ%=oKѪ= #\J4$dl58Y6R9(zTEie4~le47[ɇ d@kx|*GBoh;CF,[wL<1#$l/:,>Vk0;=WuGaԧztjr=ב5Wn hء^6o:J$:(62N 1YSK:r u-Zҡeh]jl^J܁B">w8,"\CS wh4OnfI܄ŅR®)lS~ +o-Iy11Z9k?|ٕQsSvEs|h?E*WʴRp^R$Zە2 5-(af#Gb1kj}Ee0 ١Jk۾,*oyfO!STJ=|+H?+\9EGg[< BkaSA4lJЖ&ERpY*`_٪z.hW. ^bXpkw c@5- h>p_L૎^ÜKYs[Wendstream endobj 853 0 obj << /BBox [ 0 0 720 432 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/home/renaud/Documents/projects/NMF/pkg/vignettes/figure/NMF-vignette-estimate_rank_plot.pdf) /PTEX.InfoDict 668 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 672 0 R >> /ExtGState << >> /Font << /F1 669 0 R /F2 670 0 R /F3 671 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 3639 >> stream x\o~_6n{>yQ*ˮOn̐CtK3ُK,9G~~џ_;fz?ͤw<~O녝~?_RϏG~SٮvvaO9̋?Gh9ؚy:}p֊}{. ;( Ҽ*Fhſl5y)-V4A1^!ֈ5˪d+׼Ng[.+ KQld*?rƷdH0"AF<d+mjhƜ oy`.(9%#"3q]1vW imJc8P57߽9.?@_@HnaNn8}=]^|t^/a- (ζxZf&셛;c1.9=a~eozWK^ ȁxߘa \+v~hlC~dkD\0 AF,;.u-Cl5'Bo5& {co 41(o& Aa+5_X v3nTe[#G AF,;SCyQi.Φ2.NDL4&z[hu?itvmJ+?!3ݞ0 L2qpe?⋛R:d(̂lxk4!7R~9xL1}F8Ba^dk삀%Ţ>laՈe[#B !oFR7fA<7lkmKFF!ֈ [#lBd-d,ɪcVL-fdk-nX.N\ؚ#MC@ȵ?4gs.Tιw0M8O*X0'y ۋG~1LnRqLv8fۋۃ\z<Ž{@m 8g!6 ȣ^PmOݸ87_b9k.^wC07W ܼ!Nvg[j-W0Fk;yfUϙy+G6Gz+ن`o+ByMc48!w@`rҙ 30gĽYa|œѓ 9:cY6ǤX78l 0JAf{ S[H'R1JB"粳o,)8J p>R6TvFc2cF*F=$Ss@TX! `xGDCx⢃Z N/إUmo 2jo 2bޒ 4ZpPybu@+\| U,\4/,<;yj]h]#2޺2S o](o]z_jZN&19Ѐ<"ءXB^&Qm^_$A\YOڸ eINR~Ko6e!d,>v}w}#z DOrnPCכ/Ow/_==Vʿ_] okXOe§MCK"\n~zuzv^Աsf"Bvnn%%"-{Hq՗ǟռars4*$E*s)P3.3Va'O0F'1;5ya \㝘\=x%WE;Iޒn.R–/peo|=~APDs"L_{=lckѿzXk}~PJ`'S"pZѲ,yan ā]pJX˙!< j{F< j{3r´n̦^N:('I?tQN੥*pN:~Ԙ"Y^â7ėL9wD3D ik9zUc Wgh1zu&m56;*PSxw$Uce1r;V~Dҵ-ӦQ)JeQ)z'[&C*nMjy:\HYNn~ˁ}7Sٽ{iݼ}or%kBN::h:v{7ocTwzK赲jZᰡpJE oQQ }|lJocve7Ae.n]~ӗ_~;kr@uhVeh c v+Q~*TDwHYU Ǻ*+|VeX V1y\0t\Fwʅ +ݕ FW0a!cTӟ*}SOLcvNΈ^މщ; :Q{'bgD/joW7֭xV/ 픯`|e^-{m {P]Z.2Y<7!S4ӫlW7&->#%}P̚耡(Ҵ157>d˩ gQ WP?>⟀{|ĕYtXW#p]O *rF _!}{@5nx3Q,$y/OSSݿC-dUg' ͰO):'sR?WU6{\faUywnv_ʹҖ-vˊxeӏojbJ S뿏 uendstream endobj 854 0 obj << /BBox [ 0 0 1008 504 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/home/renaud/Documents/projects/NMF/pkg/vignettes/figure/NMF-vignette-estimate_rank_hm_include.pdf) /PTEX.InfoDict 674 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 677 0 R >> /ExtGState << >> /Font << /F2 675 0 R /F3 676 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 35099 >> stream xϒ#U񹯢0,)I>@0'}]keWe=mzO*/UT^/߿g_x˯.ry]X_˯z{_-ivyME_߆u^9o˽HH룸e4]+鲽6N7~. ߽-nwt^-{i}p^p^^܍KݦםiXŝ<7pw:ދ%j=fڶjjKOOGOOڧVZe}F\Mulz:ÞΆ<_1"i2F$n(IQ↖&isF!(i$J↦*nJ↮}L,nHK↸.iċF0iDLȤ2jLB\\?N[%JҸ4n(KҨ4n(J3Z!JҸ4n(KҨ4n(K FqCiX7 QciP5 qCiX7fB7`i>/IZHFҸ4i$MIҤ4n(MIFҨ4i$JFҤ4n(MIҤ4n(MIҤ4n(MIFҸ4i$JFҤ4n(MIҤ}^O4i imqCiX7 QciP5 qCiF+qCiX7 QciP5 QcixQciP5 qCiX7FqCiP5 ƭ!&XK3MTHFҸ4i$MIҤ4n(MIFҨ4i$JFҤ4n(MIҤ4n(MIҤ4n(MIFҸ4i$JFҤ4n(MIҤ}^O4i i[HҨ4n(JҸ4j,JҌVHҨ4n(JҸ4j,JҸ5JҸ4j,JҨ4n(KҸ4j,J3Z![CM4nܫ_`4n(MIFҸ4i$JFҤ4j,MIҤ4i$JFҸ4i$Jyi2AҸ4i$JFҤ4n(MIҤ4i$JFҨ4i(MY.:U ϕQel7<]Fϗqf7 OQhD7r4j,JҨ4n(KҸ4Ҹ4j,JҨ4n(KҨ4n i<Ҩ4n(KҸ4j,JҸ4n(KҌVH֐F,祹ϯK4 I#iH7&qCiH4FI#iP4&qCiH7&qCi>/M&H7&qCiH4 I#iP4&qCiH5&xI4χ-wIҤ4i$JFҸ4i$MIҤ4n(MIFҸ4i$JFҸ4i&$JFҸ4i$MIҤ4n(MIFҸ4i$Kyi<Ҥ5Yݰ QciP7FqCiX7  QciP7FqCiX7FqkH FqCiX7 QciP5 qCiX7fB4`iXuߒj 5%j5|*5|:5|GR͈եjZ5jj5|z5|5|5^$#|5|5|GtbqGxbqG|#_F#_f6_J#El;mSF#GG#{Xx)9GшGb#{)9GGbc#GGb#{)9GG#{XxXyH#G #G(=JD٣Dȑ=JD#£Dȑ=JD#G(=rd#G(QF#G(=rdѣDȑ=JD٣D(=rd#£ĆGa;_MGd #GHȑ=R,kԑ?lTQGQGuOU,>rԑ?sԑ?tTQGQsGGOulxQGGuu U,>ԑ?T RGRGRcHsHG>ԱG"uxx{)9Gb#{Xx9G#V9GG#{Xx)9GG<)9GG#{Xx)9Gb#{4bc#96<ڞ#{%GQ"z%GbQ"z%G#{9G#{(##{9GQ"z%GQ"z9GbQb#G ԭ}"z%G#{9GQ"zXx9GQ"z%GQ"z%6<z%GQ"z9G#{%GQ"zXx#QbǣuaGb#{)9GG#{4b#{Xx9GGb#{Xx#b#{Xx9GGb#{)9G#V9vGD٣D(=rd#G(=JD #G(=JD٣Dȑ=JD٣ĆGA٣Dȑ=JD#G(=rdѣDȑ=JD y=J$/?e_6\Q_m1s·Fmlf`moݍׁ[<;|X0oo'X>e{nO4i\krM+^vցۼ\N4V~{}=X'+Dc|{5Y&:+Dgh|ߺrO4V=X':+5Y&:+Dgh ^hh{rO4VZ':sMth?xrMtV5Y&+χ5H2MFǟHeom|"Zg5ZFZHgȓ=YG:Hgi-_ZFZHki-_#{|t=YYG:Hg,#r^FZHki-_#ꘝ{|t=Z.ZFZHki-_#_{|t=Z.5ZFZHki-_#&{|t=Z.ZFZHki-_#}۝{|t=Y&YG:Hg,#]ik|5YYG:Hg,#5ZFZHki,?63X~FHk:|5ZF: L{|t=OǷc~s㿽\{vsy^7od]t_cܰ~,o훷1^/-_o۱qM㟺K7u 2Y}{Qdt}7?Qnʴ?}盢/ߔݔoʸݗyGCOw?o}VOޏ/Vwsg?/?oPA;,]7I:Dw#uǑi|kv`ǣv_JU#c;c zؠwY`l,|Y#w}ྼ[T e۾[<2v}mtYaь|avIûS<.xrY`l~]#w.׻w#Xe>̰]VQs?#lU{׼/yN#umߏLs Foø˪WGm=aƓm;ۃ#cw eCmG6.۲Gͧ˲q29jecp.m:ve ?o eY7#efp{7O9>̋}rvYƓ]e黌w"=>ܰ;m۸r߶#ȼ>.G6.)~jǑG8L]Gsd# lyCƺN;lyp?v:?^?ɱ۬cu0"tFny< w#ϟiȖq,vYtt=+#+lɏDZ|vH4m?=ȶGf.ϑ $.3tO22]e属G&'q1XYaLclw=:?6?vi\!>#lz6t_]_d9+#+lb`ӱ9r[,ǦY ތ xoo1 ˾~h唎HSJ).tDR"^Nt9DrJG)9唎HSJ).tDR"^Nt9DrJx9#唎HNJ '.Nb3rJx9#rJG).S:"]Nɑ/tDR"^8|!7g<+yYBGǑQ,qdy yYGgJGGǑqdy yYBGGǑqdy yYŖ<ayYBGGǑqdy yY+yYBdž<ύ>Ua{DǑIDyQG'qdyQDG'qdyQDǑIDyYDǑIDyQG'qȓ'qdyQG'IDyYDG'qdy;W+yYBGǑQ,qdy yYGgJGGǑqdy yYBGGǑqdy yYŖ<ayYBGGǑqdy yY+yYBdž<봟mPȓ8<(O"$<,O"ʓ($<,O"ʓ8<(#˓8<(O"$<y2$<,O"$<(#˓($<,ObG~_%#ˣX8<<,b!#X(8<,b!#ˣX(8<,b!#ˣؒ#,#ˣX(8<,b!#3b%#ˣXؐg[{'qdyQDǑIDyYD'Q,IDyYD'qdyQG'qdyQDǑIDy;dIDyYDǑIDyQG'Q,IDyYĆ< oQG'IDyYDǑIDyQBDǑIDyQG'qdyQG'IDyYDDZ#OFPDǑIDyYD'qdyQBDǑI3,qdy yYGGǑQ,qdyY+yYBGǑQ,qdy yYBGǑQ,qdy[xqdy yYBGǑQ,qdyFqdy y< yQG'IDyYDǑIDyQBDǑIDyQG'qdyQG'IDyYDDZ#OFPDǑIDyYD'qdyQBDǑI3vJGGǑqdy yYBGǑǑQ,qdyYBGGǑQ,qdyYBGG%GXGGǑQ,qdyYBGgJGGKߪIDyHIDyH$ez#G:Hg>\ﻑuU5ZFZHk,1,#{|ts͔3X~FHci-_hh-_#k|=YG:Hgi-_o@m-_#k|~=YG:Hgi-_oi-_#k|}6g,#{|[Hki-_#k?*6~Hg,#{|YG:Hg,#4~|{?/^/?uc?uo~azˏ3vmn67rm=^|QߖY{q;=tZy?|]e۷ifd^EK)Ӳo~S~|wS>!tw_~edh{E_t%ׯ~[q{o r+.Vbjoۺ9/_~˟wcy򝗢/zڬ_ntOηB_fQn{?\EzyG<\EAO>q,cxz8Mc#;cyJˆ>K붜GF.Ǐ<$17:Y?W}r02zoidȺN?lMҺލ;G#oN# l4e~;a*tWyk.bGN}3?ຝG6.dl{72~Y>Gno%}G.}w.lypC`=+~C42v)r4v)ϑӱ&v.oߖfd?yd^lN99Gzϑ^+ZNvx^XG:Ѕӱ92vc:r;]:J=y|:V>/^?`4}drՑe?z8\>r--G Xh v>+#+mq1vyp_/\w#lC߇ydrXU?VsN`\xX̰].zpc>B\ѯތ<`翌Rk}+ru/r?+W4~>PWdcF.oFn瑏\_t^[~jX Q>0%FmYwE ǻcӬ?,6z6;e7C~\CjM~9vӋ ۻZc<45`T|}#TGf)F?7#O|/ױuFZ׵nZHki-_#k|_.|t=YGZ;[Hki-_#k|i|t=YGZZHG~b8mloG::Hg,#7L#{|t=ZNJn-_#k|_޼~޽|YG:Hg,#Ԩ5ZFZHky3T?L/ח?ߏeOݛzˏ"ccy[n߼-z|};v|?{Sw33}ZyOXKoӻ[O/L#w)MMIW}7{<3tZE[rz+Dߊ㶟s}o~+n_o=ͭ3ot޻B=bg=[/ߊc}?_ǥE~Jw^軝_xέO Ww;[q}7[/zڹ蠜[qy}[/\=z~O ]pRD&~X, *tWFV.bG޻Ιc rOq8"Z e{dr`KrZ˶?8?\qYa 7;6ι?|7r?{72qѾYO#3lm<?߯ydr{hOx72qDr42vYGr9]V]}9<`S8=NGz9Ft#3lUwmyd?Dl^PZ*6}=L]Vq1yd2]/-y;.u#4e?/xvTN ۅ~3vяi;+iǑf<2vYοd^e\lXO e~\^(wyv)rȺ #W?R#csd2uXG.c+#lFc^G]: ӱr[jaj+#3Kס4v<|Z8} vxԯzt|,].zGf/cst|+We</w_Xy+Wtnۛ^=<떖+uO u}xp?].L*S}mݱiց~hp>"9CNtRMNt ]5Uw24UkzǛF53TkfNt1 ۉXz;5<4/~l\ӱ{7~|~ǧۛ?_7~_ߢ=v㿷2Ύ////{uԋWQ:_/U~ aE<]_wwpQ\He\F* \Hq s*WR^<xM/.ݥv||h5RYZ]'/p.rkw)=\T{`+,+\iӣz \ N~^]:/վ\ds￡+:4~ W"uߌD)9ND8%Ji8'ND()N8+Jɒ=hI#[҈z d qCI҈4 1I#M #Nȓ4 EIcRHdOtLY%4E MMQBSFbS%4e.WBSFbS%4e$6E MMQBSД%4e$6E M)nhZO)jl↦)nhdh↦)n S40࿬lD()NdD8)Jh8)NdD()Nd8)Jh=LI#S) SД42%LqCSȔ<Ȕ42%LqCS>o':lzlĦ()#)JhZt+)#)Jh2Ħ()JhHl2xBS74Ec'56 MqCS7424 MqCS)h D8)Jh8)NdD()Nd8)JhD()NdDd"SȔ42ŭaJ&74%LI#SД42%22%LI#SДϛ≎)eS%4e$6E MMQBSДMw2()#)JhHlĦ()#)Jh(4 MqCS:xMQcS74EMqCS CS74EMqk)󼟲8)NdD()Nd8)JhD()NdD8)Jh8)٣Ȕ42%Lqk 2 MI#S74%LɃLI#S74%xa2h'()NdD()NxZrC̔%<7E ONNQS?xo` s 4 D*NdD9kJ9kD5%t͉\SBלȵZFXg\sk r ]K#57t-\\K#57t-\sC*'Via>oVyr"*'J r"*%ʉRB>o*%ʉRBȪdUYְ*dZFVUnhUY:YFVUnhUYV-V)UJ @* 44V)U#UJhHlZVV)U#UJ 4VV)U#UJh_ʭa'*U@*7 Rc*?*7 Rc*5z[Piy<* 2RV\H4Zq) 5_ hj@j|9ъ}LuF+.W T_+{5_,#|!ņb_FH#_Hȑ$X\Jȑ%dbB|5!Gbq=!G-m?cMES6&Zi#ژh MEMEMEScF+DScF+DS눦 mB45mB45{5#,bK4hh,#XȢ͑Esd Y4E:Ƣhn 4 4(Ƣhj,憢hn((憢hn(Zj-!ZFP4ǎhAYD-EsdQ8%h(#9(DSc:h6&ZiEScF+DScF+DScX X :iEMEME^͢9vD#,b!#Ȣ)9hvEsdY4B4GMEgohn(^V %ۅ& PTO]ndԉ'X47M88 & Os#G<&yƖf)XJ7RtC)hA)ʻh#xDϑKDQ?G/_"ꗈ9~cq~>3 D' )DL|D[OuD76aBXMR~wJR& )VO4JRj,JJR&,e"JR&(#KRF2LD)YDґ'N9jl>OTxo,O1Si# il4d6D6D??/φφOCgCau;2 DO%:SğN?*4 DO':cTi  )4Cll4d6D??? ٟ џgCgC!!p'[e?V3T`hJ$3`q)3xει6c'د5bMe9N,68QXlp;G ;ѐiML~iSp!Ӑ)8Ӑi? ٟO/ߑɪuF5 V%9XUi'9 ꃭgNU͂QJUЪblUv'еbZa'Pb=o[rV]kcךkB6φhUC>l4d6D6D??$φφOCgC<4LIQ\VV0#S6c'*1iE '%+81bsŒqFNN ћb|EmFO %hъ Fcy_g4;žL;g3d 3dl?C!Op!Op߬mvG_3>O$ub8O:\}wb8Osa'N)=l[xޟ ?=Dp rm3ZY ڌCd>o5BVmXuUUWHV]!Y!Zud:dUWHVmV]׉vu3kJ$Z4_;\w]+5kصłsN$U][lpXJDU]+Ʈ-6V][lpp(~b:®\Vpp!֐]+8֐]kk ٵZچU75aVu"UDbU'ЪfU`U:X [,U@UتfhU1Z!jA&VZՐjVmVmUUU ٪ Ѫh?ow^~ #~vy˫}Ztq궯˷/:OU8S`c[=pgXdqy|8rJo?jDRۉC:߼H_wy%J$͕H+4~J$͝;4w"i~z=效+4W"iD|.jD܉As'3j^Is%J K\As'N˓f啈>̕H>͕;4?nO5%J$͕H+4?nˏIs'N͝H뙨y%J$͕H+4?^ۨSsз6a{yv_ewz7-72iN紹ID͕H+4W"h~޿+jj{M"h|[{W64םJ$͝;4w"i^ŎNIs%J$}\w=w=Ÿ/ߑz3ाn :pR_=;/)|7~}4HRo3 w߷VI}E'xxnaCm?L/aiwzG/|s2ؑ~EKnۻHR7IIQPߑá]$;DTw+I+2ٟ$b]$$wRobw$'NxT_GyR_+>/\?{#%ξ.qֿڝɻ5c/M+2wً _RKj%{#OYKeVT_+DXR_ {ᛤH>A}G/J{݊'{#I({hr~Yq{,Cs ںĦ)ѻɻ`~t ;2?//> \y:HߓڒL|:^NdSy~H~:wCǓPʨ'{gP#&ﱟA}G="`OocY.o /Anv9\^/߿~o";?/ N6q[{ݼz[޷D۱;ը=hm뱼Ͻ2nn?ރ>}:q=V~U˖wNސ#!zeC>moF1.6c.۱y:6ߖq zeۀc m۠\aNujeu= oÝc/?x^rقCoW#kq`z/_-zv٭+=/ç!oAv}eSZrJeꃓ(ZMpC;SB"y7ޥ;@OY=ӧ>Non^].Cv`.Gw)z$5Cw]f.1v %2Cw]f.1vKe2Cw%r"p.3tW讆讆.CvWCt!!a.G] ]} wu$p#. K%*6KUlpKUlp.1v.1vW]b.1vW]J$.1vIv!ː%8ː%8ːeK]..Cv!K0r#Iu7-{]b.3t ecw]f.3t %2Cww9K vItWCtWCt!!ː0p#쮆>^] ] ]:ˑ]Z e2Cw]b.3tKecw]b.3t eKD.%]f'] ] ]쮆.CvWCtW]xEw5Dw5Dw&H.G"wk-9vKUlp.1v.1vW]b.1vW]b(5%)`C5# cwydw>5BF>ExPtG~a' ى;ѐhND'=oi &F3Chfh416MfF3C)F3 MfFczD5 ֑hFs$1ZGh 9FkFk h hN+M&F+6MVl0MVl0`416`4hn 5#=| Wcp;{59q46>)LiȦd)201") ٔ ҐMiȦLiȦDSvV4 MٌLilFlF4CS6#S)))Д͞7);AlF4C'6{~N==Fs䥎VȞ#ov=B2 7ZGh+$ B2ZC4 h ]j x6MVl0`416`416Zhbl416Zhb*M 6`4h&FF3LHb4E&FSd0!01" h͐fFfFd]}uFz4Chfh416 &  !'~fh?3όGSޜG?^uo:Nc'i!'؉fjY# GI{aS>xS6$S6f߃)tMM~AS6DS6DS)) ٔ۷ MicS)ؔfhJ34ṟ gcJ$~N๟9| v")N4C'^NDu;68!=> &S>xS6$S6d'6D'IЉ щ щĆDǺK;Q(N,68QXlp;QXlp;D1v;Dĉ;Q ό=91T+Ցstfڑs 3s?h h h͐fFfFd6u74 &F3Chfh416MfF3C) 4MfM 6h ֑h ufFkFk h hNuCG6MVl0`416`416Zhbl416Zhb*M 6`4h&F͑h$FSd0!M02#l4C6`4C6=F3dh]ݣfF3Chbl434MfFc 9`N.[Up!fhǎ pp!ak ٵk ٵ| HskеbZ3t ]kFv;%13^'{ٌLwzYl2Zމ\`5NѲNJ$^v"e3rCx`k ٵ ֐`?? ٟ џmgCgC!aOG4f ic?؟fOJ ė sRj6Xg8V߰9V}Drl`{/+jF4cS)hAS6F"UGGUU A6 F":nn uf&wD^> 24c/ ^c/,^K\ f,1p% Fg*.ƿ*kٜ\vVu"#D2F >}U>Zˆ{N # ˂|ې lXl`[ l6d 9pCv!qrM#еfZ1vV]k5 \DrD``%f7t XlƗ,pLJ]fwk3}KgJ ~%!(6C1n~љ#lh`C6pC4pC]]A6D6D&g p$2u?Cac ,.6X ,|kkņhG%صŦoqJ$Dr0‾vbw~ql%Wb001# l l6d 6d:l`C6!Xvg$=^7,3tV]kcךk*5 \,pZĵNU"qk\DZ'*5C1m#ka6Dkkk ٵ ѵmtmCtmCt!aZGqR\+Ʈc\+Ʈ-6V]+Ʈcᛅ``v ,%s \5#ךfNX1 '^3LHb?E ~ ~ϐgg# ]3Cϙsf91z,<{,91zN=gx { ='ƞ3C^kx#a5D s s\C\C!{!zp;\wͰF3\3zy =׌Rl)C`)C`bqVph2CKRbl)3Y`)%K9XJ Y`)'Rbl)3[ -ecKRfhR R Rlh)CTCTC![!ZbTCTC![!Z0ufl)1TRblbRb*YJR,%XJ TRblbRblbRK Rl)Rl)Rl)C`)Cb![ʐ-%8Xʐ-%X}a%fh)3[ -%Ɩ2CKR"`Kr-%Ɩ2CKRfh)1ZJ-e---eȖj2dK5DK5DK(FK5DK5DK K]4 -ecKRfh)RJ$r"l)RNRfh)1Z -%Ɩ2CKR R Rlhh)CTCThhh)CTC!Z//ݧ,,O%Pq},*ydsJܟ7w}퟼^/;A}G:ꏇe?lw֎k ۨN+2U塣^6U%oPߑ~/wQ}-67ԿtBR?]8ϗle,L.U^.5f^Pߑ~/|^*Kץߑ@}6I}5*Q}Wd:gHRU$==ߋi .yyI}̓klT߳D=7 I}OKߠ#I)̽fD=0HTS~OX ; I}5klrT3!D=h:AI}zL렾#IȤGS%{fPߑ~2ۑ^zC|5xxqsYmw}Ëܱyp/?a>۲}-FoCZz,s/渌[O?\:s=[F֑˖wN_zC˂!zeC>moG.Ǵ3cnYC1ؼo}mؿ-?v6l߷~6lklnsن;> .8>1m|n{2z [eo/`&1m86|5nOo˗Po]vvKƞ1/+ Crw8]9M}.GbeꃓZMpZw'f84E8á=2 oON@O}R<ݿg_qtMw7s?ͭ WQ;nK˯^^_?Ϲ]Yqs~=m_vgnߗ~oF9endstream endobj 855 0 obj << /Filter /FlateDecode /Length 755 >> stream xWMo0 Wh*JW-Àuu=֎WߏI Κ^,|I#X;>GFEAP$䣫kFnQwA֐'I-Z<#F_0@og0FDŒ#ė *KOBєe%L74j! )*˔L82,}R w9c78qC,OeD3F%- b^/v\bODLZrZv2K:/SK,8¥JWNmiGs ̥^1<+Ҙ+ ƐSk[ *nu<zasF>?fwu:[6d1+XPL}e2q "Z'lr|K]LgWh_ẌJ^.rՖI[[b^=nDR.N{ي$A2ٞrއnH"o\,](pdSA+MȗξCev+Cz%c,łmX VIOV?1dldV2Hb| HrXy.떋b'ݗCp[98&C4D.kd gʑ1Ɏy_?V!aPR72endstream endobj 856 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 857 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 858 0 obj << /BBox [ 0 0 720 432 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/home/renaud/Documents/projects/NMF/pkg/vignettes/figure/NMF-vignette-estimate_rank_random.pdf) /PTEX.InfoDict 683 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 687 0 R >> /ExtGState << >> /Font << /F1 684 0 R /F2 685 0 R /F3 686 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 4965 >> stream x\Ko$WqA:|6 8@ ` }8+9_zEiFF.uIUWU&?9%m^ywe[#}\h2мDX j7n poQ9v[y,a^r#VW+Ѫ~+=FR]Z#D%΍6i^x?"uPC6UY9NN2ZNEXmЮiG\Lgտ <ˣ/s5Lh6GJ3(~p0MVVc6+[ɱqm9Эwm9Pk;ft6 v^ Ӗ倱y+wc62c_0nUhi5-G=І#VZНT_h$-0F'[88;d>aK Gv57z/=.A~[h![EŒkrdX]g86p[3i5&ZPp08~3 5Ba4K0er$QP`ڀiM"=0f#`qf8J\kT׆N .ހi Ö[bn:TqQေ "EGxbһS4w71L#?p0 uv1.x(f}N' TpT0LÓK LýUڀit^vi6`P\'C V'iz܌{_p0 wf`. ] t8Bࠇr0m9 mf\kMʡ`qf8 Q|~|_A_N#wvѨ@FC(@@a[FCGxЈhٰ@ Ж&L X}{Nf0>łJpM+p06p?!A+m2Bdz6WɇS$ kɒS(m%c2eZW#dBc\_1$^%3BU2Jdm"dd*m$P0E2tM26AH"tc)5TH $DD26 ^MLzn%) ǃ7?K8rl0>f=^ vQ3{9 r6t %5c kTcPdrۙ4"72me02^yhJ% #!ɕV I0h0H0h60H<1jfQ'޺dfr::W0тS`=J߰?f$p7 dä605q)d &ɛƘNXgot ǛId/"Nmab2/^: vA[n(S0$p&q7GTnnëp z8aMp/#`antxe8v>AQFk*eš\!QMq rPS)\RC@\M%M@BYZ<p&hnLMX|9Rb ja a1(e@\ *i$䐋(lE6pL^Ltñx1Jy(Y"$KU$RSZ= C9v'~e0QX4*|ZPoߊ i2YQ_~{K^bz<3Ll旫7_>j*}::^]`+kN.L~N5]1Ic#_nAK>ME'V8gXb<3?}%'%uS-#Г-| ˇyrDQ 'fq?7K'\"ݭ\97o[c)ak-]ٜvD2ؚWwVw湖VwܮYɥpݱ.[ȧK^TCoi z<ҟwJ+yK 9Ê9/Zؗ@Z-yK UY8K ͱ(֫ 1;HesL wY?MK充/5樥E}ҢrhiQ_j65k۱Aa=+m3ߥ7[}\]+ѕ_5 07׼4>՘ǚڧZMs^_€%/5q؀ W߀b7m)9^bk6ZflgF GF,fitiϪ`|EK#=n~%7Ut1+ִ_/$ۈY?EsS{ @^qTw6מjFxF C:$aH=ϺH=j VCP&8A``>e7B,h>+fo펽mwe·\gNhgU)د}ԤT/&qt|15)U]ʹW/gU* 4UT;Պ>Q (fءVTZiW]{ &aqtk0 㕣^IoLxpVeXQ":VAԬuP0G+bm'ҭ+x+Vx+Vx+v}P}ii/bvE]QpE]QrtE]Qr[ ~i>*qcj%pL8SZ1UPuSUPuSWPuSUPuSUP=S+qcj%pL8S+!ejSAqj3AM <Шq6iqTզvWjuhpÝk"R'_շWo|}=/o|怒C~xֲ.o~NnąG>? F^@ ow}z0 ;.wN-/㺱1ಱj!g t }d i[|PK3QaSyd.I]}A[sE"ӭ^vS\6㱆ÿ9V!ѡBë?}yLpjkI;xV;0zendstream endobj 859 0 obj << /Filter /FlateDecode /Length 2061 >> stream x]4}E_~I"MG?P>[!)$x̍;5a@4~7DƢܐDA|Ja>R.wRwKCx tnF9{d|3M4--hO!He~}hC. 7]-bMqH<0"s]6ZUj΃Q-2bݔs))1浑12LM͇;w/ZjTiGg$3B Y*Bb4b 0.~f{PL m}|D0D;R ڌ_k\֠&~~"}F7C;TV*/ˢC+х:;8QG>] تWy8N9 wU+M?KĨqsECvI VD;iDkuzG/󪺵a[cf;H  1' 1"_Gĉ׈N8’t%0]溒 3ƊQY2y+Bw0QHKA5 [-2ʲ|3TV{T"\Y^{J_3K'R o{v _Kڮ%|FFZ(DOpRDKСz=@3QdnFglιPjevq5KD8Jļ2 V4tgm8^&1Kر)RJ&i" q^SS$Y*#G'|mvk|eaO0ލy-ka34ke賠n `Ԕ%T;\`"ئDY*)!tvz !̏SԿ* Oc1nn&FCTso*•B .Aci{r1,G+lѬlݚkUP'un 1/MҔ> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 861 0 obj << /Filter /FlateDecode /Length 1902 >> stream x]~(E2ҴIk\b'N)R懍K|gv(ΒPS8;;;3L$Os7_"=m,qw'apƅ2hBeF)P6j\4I79J)hL;@+i 4GBQ)"#2&fћիvN qf:I,""0ՙ0Ǡ .-O4.]K,ϓM~+,]g4~ErpD71#>TZ$9Ny"UEC=Dr6|W#,d0!96۶&R'qp4h\ۗuτgx]떚YC68jԵD-?pLs3l]MX&8U.`8{?Bڅ#}aKp #GF|?iKĀ;v} h^Q m]ږmA?3(폁Ĭ^p.dU*S~lj1b&*5at\?-˫=jFٚi1П'eThrQnIԴ Ӫ3]2`\FewBik Jങ3 c->)FhŴTJ ,JH0pa??Mq i7Ot:<»'ffD7O ;XLS.5Coy]7A!U8=mcq2(^!/<vܿzu cb HiNԟlMH%6l:!F!@fzlC0-~l.$1bbF=]MRQoJěp* Xoã:[.tI^;p\WY`0^yGx*nzh) ځq;([,sK »ys4Nfr?hsS[V侵9*3*njb2d  B.Y_=^z/3,ۯw`/m.*' gPKo@H,fjSFH ?endstream endobj 862 0 obj << /Filter /FlateDecode /Length 2831 >> stream xڽ]۸}Зj+~+@\;\mч2m%G)˲M^_Lj8(XQMO7(AD Jd*ߣ` k?ys4a^zJ#*0i.|FXXJGX&[;O`Ks7aNnL#%4 ܨLi(XM9ongb:X$;7* rJUGA*A pW?}w pƇ(: 먯-1, &Ʌ7zۅthNܽZw+8_w]i•؀BShEMe?XDaPG0 c-FU2+Lvq>U:v/7i< QNt2@.&sAvu=(V4 O@®NHA5.v7}BBjN 0̲͹Ob|1+(s3z=%'[s4W< 4zWVq$I1Dyg@Дa:uѡ"Vլ0^92mNlO~lK ǍNuC֠ $ r>.&U Fpv3T-Á?sYYA*ysL]cs>&س\:Sl&:<#09i҂Chy\e\1F_@Y7R[؃KӠΊY@c6@ ,0B檎\ā Ig?UT^FGQZ7FNnm$U=,;6=9DFɿzdiu7G4I!9yΊKE@M`&"ʤus aEr+<#8m#Pgrԙ˸8r(O%3Eendstream endobj 863 0 obj << /Filter /FlateDecode /Length1 1439 /Length2 6418 /Length3 0 /Length 7377 >> stream xڍTuX%t!ғ.0b1rҢtwJJ(H#ݒ"! %)}{=a-k)"hn0H HCOO @< UvPnp$B?0P0'A_C5 @ $C<6@ *s>BxvN١@0t3 B@ | q!p_%%h1^^OOOe'큺07fE qM ԷCڢ=!(nI xr!y<@0rf*GN@Hg`@-Eu ABܐ b} =<(\swA~U60 k>y8 >yo޿D`m_Tl]x pWwk @" ! jr_Ÿ ]T`p[(w/?`0Eavpn^@3_,pyuT8&wXNp | $* }]3o6|QQaA~);h"dG Aw_U2ݝ~#/'z*@^kP#C:wL ֊,)½`6p4U&;0m +v>~`wKiK|B@ \_%Āj@^}& EnUH+jm ^[PhV8Vth֔s=ɜYa8fT\c:9c 1Jc+Bubiӿ i-mcשJ}*+EaՐFͦWwD E_<ǖeRyxf*D) 5BWo,i}U]P4x7k\"T2̦Mgt\/-4ݚV[1ܘvŶs\dbI=?cۙ6u!ܩR]fx]Ci8+{=Wx͡>\ҏ#p)2*"L"̐(0S! ُ#y_I*z-n~g,X.HTK9HTw}+3?=`=k@&lQՑN9XГv78\;kQ `]k(v_wmtc==o8_sԚ+Q1N/{v+m0~Qbƨ4m|=Ε5=q#?}cy_]S7x_H*\'[E^VJM!.g?vI1g(й K}sW]jRȣh3y%m}n(+ܨJ|X`sV|j`JJWp+:~˟? ^Q<#]$ᒜV`ļeC[(r2p(t4w ^,+`"M ?=.sol' $

~Z A軘oFc)H'r r+79 7ވ0xaؼ\J!1)e  . JT8kOUjCBfKLze>$bԇ,4QqQnPO$tȗV؉L*OӞVDuHbꯔŊd'#ÙL\̳L}YCn+.^CiP#n^hie}lEs$`F7sMٛ%̳>dVVs! {"R46U,}-j&8Is[8zMiVu}ܨpHzT ߇B$HB-_lT )E.iؾbw+RfǤ}RYL[ mwS en)Sr?@Hgom[iuOvHFsc}Sw@~T/.1:XsV(8Ɔ h3<-翚6HGeKhGڗR)Z{WŻ>wyU/.$gt Fk>MC@8<5KPqlÌ-\2rYS|x۩By·U4Dm_ocaC݂0/`*z3yJVK"s+'"S(?a *+kx:Qv +>|ͅhT^ŞnYp$P|tצO2IUvo%@|Y*a2T²s19h鋔Aܯ7 ]R4= O[wσYiҜ M.+G Kަ`O $4eUt0o2T8Ӽ6 Rv5xXlQPk6Xݶb1oFqR/LҒT?A'g>X80bF$gE4+KV; 1Y*{vVMK->4ebsE~qAzif2]V)5"{uUuuճϭkȃXX xBwE/Xz`UcHD¶Lp"ӫrh.evQ.n'hT{lpjEY8yG} Qk{V~\Rx$}Zgzx?Ђv~Ϭ=lu3(ǘ>x*4uY5#b a؁w=8l4pXރ3$q̷ =*7Z89mWM%7ي]~;u}3-[йO5yD}PS!)~%5P(.,'7BIiZJe]~5GFGӍ?,l]})Y؟clp`*BWpXbG/)\(6v.vjjlt`gCf ZlJ<ƣǥ&ɩ7~Pixt̬t<2 G|cg,[ 0bF~s!6hIf[3V)6ߏ&ySTf=c/9LN0dcLm)Sfx})ө[NLXK9xp?+PvgVGk"?;Yc)nGf[oE´YӼ[ģq*GoB2̳QF<4>!<򛁟zr;륰z6)=giGvpí?ip/vyj{}%5]VB {C@>?"mnO]97!O\y:nw۹}џy=:bVo~Z~XQ铿o5ͦy=Z{]IJ;ϔ +2'_z^Qňn^,dG E6I1cB]CFYU :?7I!q,_60rk^=Y:3E)󐋹>Q48~ﷶiy =4{*P AݵU88,)?ݴ`2ޑUTRd_8Buh[xZ33M:\ϜŌI\QnS*3ͻT|$?IC2>M&MyJ ]g2Yf?3$2LUS|Ð!0!߳4ߌU;r+ssy~S2b)uV`̳G=112/e`1(IL9r^VcIKnb,벃~ab4gj-[̛`asGbTi_]lbRB8<.]4}j̕Sb]cxy$` 桘bkU +,L4u*?4Ue|+ּӮ'ظg򞥵X♺1;h9ЙmF'z{^x*wEDg>蝠RnE7j<y-u6{h>Aa􋚙/d<8HZ\v/ع.k\Fl5W/jĤ&(oNDƬK=Yr){US~N<3}6|N9]x11ŗ{ģF oQ2-Mt*6=>C#N|SWB*Upq`ʫE:m]o[{"6T/ >R}:toƝ:F~(6 rC\kC z͢I~ p thN8qjf ̻mfG2ɻDAo? l7w,lDCʫFOk ߨ2}fed'MtOppJ/KᰜD7FbJ,tZY&OnZQNM)||pDmXWoq{`nY;-{'#>Z;1)(Y4jpr7 3ޔ恸fA[g{ǡ.Z:hlv9rfVfy)!c9p,voL> stream xڍT\.Lw42 ݈tw7 0 1t twww Hw !H(͝7{k x #65$8x8Ҫ::Bnn>Nnn^,FF0QBEvap B!%wG0077[?D0@r4lkW GHHplT0; `Ys:qB]mY`@ rY P:RƉбe׆< Ak+^PwA"E`}6NG"0`Cl6`G@]Nc!nPx<vZ vIjpsr;8H# e!P''G2`WؽY7Cmḁ eMXm @%yYq^O3\3`ۀ|܀ o#,5 ق!X 0]^cn)|G?KGFYQI/^^>>?/K'Ginw>E  GC°> 7ං?!SGoCr@' K Yd vw_" _I?v{50+??4n?^7fMW _( Zu/@WW77|x><y9.NlX\ K_K7pF/\jK~#>o7WA ?ި5/\ 7^/1 pl36 cAx*ow,<d+%. Oޥo7\3|ib.-/<^~)7Gݿuapgw /' rwu>1GYa-/BDBC;j%<9M1~OeYvrCOb ^wL'Xݒe>砭=fǭy̷OӤCS 4:v|]|{s]_i_y{5 /~ܩy}W>cT2Ϙg@N`%:Ÿ?#ʙzUg;+1}{K[/9 9 ^ْOiq̺R67 ''H_W/I `@1 붪X'q_|0\af|X-ٙRHuUjF.թ(o6>ʐD"k(Zug,dݚC`NhsѳTӝt)~\BҊ} Yzij"s٫.ƨ: g@К$[H<qU:jw8rD2݁'YI|Ίv$[*Rg8_b|e+\6Z W]֍Qgؗ~RMSNEM%]#\Wۨ͊b2m0jELJDΚFCݫI5ljw*Jxv +dnN&}kk/p%աa"'[H[@KI-yoZiM~ ȷkxp?2PkaMSy8kl-{;zbyzF0BlZ>5;fѝ4]WL&zuщ1wi"B?z lwei=Ӆ64culy}um\6"uJȜ:)kga_;v>ʎxV]s!R#@#6/۷@ETl=uɏ"Ҁ^QQ^_df _|z[+ Ӈ!2>ʄ(L+FOi+5JbeQ'iiez;|NiBd}Yből[q}Z>gC£A}4g9_3r.Ky Q­~x-1g&=rNtrNA06gAoBixoS9qP-sRlG3P~=ZC\YbuwN3j3BWkJJa8GgGh/rP'a_6њ1~*>y~ŭI^,i3HWQ(ApnC>7$e9 i,')/ԫm OSSp5ґO#LxIGR^>4+me#תe` cyRaO[06mH'K }(W'$X*.1_A"]73z7!+i:0e6iن='wӨE;9Z5S-/fݣM&r)ngg JV0.fCc0z$S'o6KXmeSlwOs2 ƕ_I.590$oh-#x?6qpf*~8]Ǒ!mK+p\XH<#l%tn^5Zj*|lZ*qE_fk$¾AvzA\^'jngGqO UNw$=ohbolr4IXx^m"ǭ"/TTiPkaδrdE+xOP1/zv2y^5x855"Y%" `H`jk#yh$|]ZiP2h v!6^+ SɇэIE9'F$KҒͧfrE:"L~l%%̷GUdXD*%%f0Tc"/VEҮ-Կ́xLnս q /NI?`}qblfn&zs̩ϙ<Lt] Ca];2К|KyreY!!GE%7jP^eՕ1 JO@.oJ Ɇ̧.-tΈUh99ܳc} W< |U}՗6ln&Z}z}YOv dePyk`wm`nas՘sNcV尻&|9v!fXL 8kS=E;/ɢ25{N91ܑޮP8Qj`2Nrn c_b vvX :6^S0BAvij]3vJWOZiD_ȴœEqɎEN=^y9yLF#EΙE೛r?]o3KZ_ [ܫqM/IpXǡ9u>, Ѷ"P`lF?1E"8}WW i#~!Ie8=* D s mr_siG,MĿgy\V.N:I~W E<`EܕG8DDţ}&}`' 䜁]'O7zJZ˝^(G,6{APy\(W&ngCgF'nшrLlofy*SV=L U ̩a_;/~2U0?&/qU[{:yg0DPh,>A?Q&F+Tm"#{fѮ.eCs!iNb~EߩۉJ`fcPv:FQbI`,d"ȥ[Q'7! t'Ŗdlz;j{`d6qO+i13ڀ݁.ե.Բ jfa{u%:9ƀ.b _A)ƹ=`2Xz٬pAYMn,pu_ B [S68 f\Jt]2TE#Emi…ݶf4r6J7A' _ޢFӕNbVxLQ#w,FЁ; RX{3:Fu s5W|ԞJz_bQhlXqX)H4GZ} ^,!\#e lm'י~Q"d}[GՂo;bP>@_hdh!=j[QrGtXܮR" Xog B3jH~lzLeitc4M:id&ⷸi5>&,zkJIi NհbBH9G lL(d9 ս@/>䘧Tm(ڷ纒c:* KpylMfoJ=D\lOߦaToq3BCO<;qMKrYi!2F?feBw9s|>5ؾkf;ckpEu6TRXjuy'j$6llsp>aae!Wj{B|"˔sJ.l[/uEVgmqM2YOR'o [1:m ]r{lKŷ=WK ֌7 NrT,| \ z̦Ɨs}ܾۂg4Śi{]Ph(f]UZOB*@WsC]3FjNҺ7pD{PDJ/;Fel0h;/PaRp8]%e'HUU<ń T4EH t{-M 3Zc͎ݗnj2/RmkԒJ^Mt+b`lX=%О{?w1k|hwNJtF})MTK{[Sz!_ D2mijpV˶$Y2?5ɿ{HFS-Z]y]h;|gWhRfU+]i|Q}\pbO6xwpIH]\E_SO ?3G:SsohU O"ŕLG~=6>LY^ = ="1LvTr%I ~[@vt\ Bs FJ<5D+ of@a[}Y@h:.J:$\g}15&?K?TiP[b,DwJIePJY?0fLF9z>eEG7q״<֟+[ ~>G#N^@.0 >4H>J5ANjHI,)+b{moD\0}Q o](v)Cyy}i]̽0ˍ]x#Buwb" w6KFmpCxω +#ip3Dgrypр)D:#k.++),.+-tސ,Ū~]U  O-,^q bwm]'5 jӜ|kL|yF ggQvDYL[֤`16 Y+gbKQ*"q~C\OCVm<6J*& /F8R.=|!i0 ,kY_DCf2U23(V[J}]QkupH1fif*(eU!Pl%[t7^{f0:sLD WY.:㻼m>agZR}?L{a;Q0 S~*A㥘/p//o\ UnL$AQy2g]iuθ;ERyC/ C{!fˁqĊYcߍѼ5Ǎųx1J~ `9C{SHDĽ>&0=b =i,BNVn?1۔u|-!48s9]~ 3$a }q/?$v PJƼ8tYIͻL ۠tmo={bs;Lѝ$okRsGDb4N2CQKh282c E~jC~g=&KcF6G9xtܦCT1}dQ2vX"&~I$w!BMf[j(eZ)יFŀ =hST%j~Db4蓁`oMt@OѨJ fK3}Q-/YZS#$XaVS dxM@d{^q.ҷ48`ڠϿAKiͺ{7HbqyF{taЛş.nm߬P-FiYآJ+ ]Kh5!rqI&`vCM8s}9o4-rp%3A([(_MUqsbg<ǛL7kRFeAˠU TMӜ2VmXEus|~2ǴLltyz 2֫~d>C(Cj "M4sfA֞w-sWrc oF;:]yC 3P̰{\ yf y[&amk '\cEcwJgϤu(EҖ)&pK]{J;oXյلHk C.C3eX U(m]8ʓw~4{1z#ZYh`aӟ^GՇ: ucwtc )yF?>)-hBhȔvsUC6BQ]ޞy'`ۮFfK_+t1TeDi)`!(h7kX<)=f+JTnjM\@m`jDhW^=mǬ+Qn Qm"jd&Tc,?6RE崘#U9 BQUMT*9Hm91@keзF ZH]-i]"1B B¦ g23 ѬPF{<+tLciJ /ytf%L[%UEK;$Wrvayr f/ny5ouY<"-WS=aFn9}qNW;72xGƹTOK /2^vNSsg^eiqWV@ߌ.uw.p.wM,:SiFcxܑ?*%(Ϋ"1^>R%1^9IOL&UsJ;y]W5ŀ|D'GNj5=or,v#R_ot6vuG {RcK~ F.fSxgQ*z- 5W>ړ`Oi<#3ChԺ&v5r`SNRAb+x[KH_g̒84ݺ %~] Q3'~ tI.zh~d|Ȭ׾+emEm˩|Q!N6i04ۣHy: #, [ Kty28v: sgUҐq29XN~RlSO|Hd(_L-U("+V!h l7iR@AiΏ{IqՎ#?ݑmD!O_Jԉv+aeW[~TCH1Y;5Ysho/lgG֩uf$ce~OKHd@l~) Fޑ"$ c'_?g4Bi`D͏;篸#S#.ann!VQ҅R7:URr1]?'Z<`G;  kDգH -XV5,˯ XKBcn*KFIaZm>x/'P$&tw;O}`m[Mm<$#r7pofαHÏ @5';͋]rL!p,qi1C꺅EF>=9NuwӰa8SϏE+`C>t1cL2!'M& :r J1}R.#â{73Ux g٥;5V ^$O'_NؿZrwa\)7zdP'R0uu."s(yɯ-/iӠѕ:\sNOThZ|,W)A>7ۈN5Wlj>M]77dEf%[9&۶jPlvMAFN mYՖggהN:|W`DxvHR12n8%&{K V7p ~W1Uh=ɇACPH89VFu܌@ aHxof%x 1|-JGs4]!p%,iK>ي9]Õӗa-Hhy܎L:~˹a H*s:`Wm&N#fZt[khD-x|zf,=܌t\G>> /W [ 1 3 1 ] /Info 99 0 R /Root 98 0 R /Size 866 /ID [<627a3734164a127c81346bc24c928e9d><62e24c2842964342864679a31492fa5a>] >> stream x햻JQDwmHL`HAI) (D0  vZ>#9A&3b`{.{iohaoڏf7>(5E?ooS5 endstream endobj startxref 501697 %%EOF NMF/inst/doc/heatmaps.pdf0000644000176000001440000145265012305630424014755 0ustar ripleyusers%PDF-1.5 % 85 0 obj << /Length 2824 /Filter /FlateDecode >> stream xڽYY~_G z M5 `Cq$zER&u~}j8 '`Hp[73/oo^J&BȬnW6Fƫ8B)ݮ~uf}Y`_d};oZ~by* _odЖyқub,6x ǎi\md(ldo֊U|\GI 4-ՑPͭ*:l)8n;*Ÿ_#XNF"|(R6;ܜ>UeCiaLSg-H=6_SВ+zt jR3ɿu} >L0I%SݗJS/k[ty[epo~Ҿ!c\W"6Ysz7I} *\E&?9 |bAW|jC(-Ȭ^1y7A,óLv0M5[\‹Ȱm3GOqiil5PTуA!vPH  zͪq-7^sELAtܟ$-"X~")_sP%֑ 2rro pWO(dt{2flToYv }S-As(F\}<tk9^$ǃK{tj#?u_9el䧮o*d߻C#Y]7}]r$^:8bSz l/ K098Ǭ 0E^d HDg2(ҟU6:񼩎Ϛγ+~?/K5w>9…u9qւ7 jd+ e g- t5jQU c58UYgmYtq`M>J<  śl#ogv{n)<Ҝک[qb S@(&W,[+/R5f:< 9\Rдc{L|졯W/T⟹ib1vH1o6b53(>+ie<\#ͅ(BSӽ/? a OX :)+`K%Qr-o*Gc44 x}YB5O"LL~GKaM".)Njg^%vw,I]Qwg!/=ñMDȍL-U摏f !e S_&t& Z*hWWVLIM3iԩP P !<c)?-V~Bu#?hw84ko;m4>b[?AiJk^ڑȳy&>.0D'΍AR*r{|+# hTs湓vLJoTa GnPe> stream xn_AL^(>fXL63b8$<ɖ m﷎nJem@#>&Zk˵~8sw<{1Jb?.WVZ8nY}%E埦eo?[KI&hAO~ оb vZ4Z lK҃1_0o+({| φxǬ/Jv$_lt2@;d4l+' zbYjAQ/F*?3&9YD>O4̞=?$Idf]6lR'0WG*mqEh7#`56Pܕ<ǒEUx.# m] `|Pd[طpE HX_ȕn2D'H!Elb UGV_ (臮=d*%vP +lvQ!pARUwe~!,IۗfREDвHp_X{3`,!Ȝ8ʌ6 & 獃#ii\fVmW&d?E zEK2 sA RxdʒG黇O9;~ښqk~h;idIO};Y2DȀϋ(Z"< vdM9N zz TN(ebtPie)cgMaJq:qUV$w  ITiJ:ܰa텵 cTM%%LRD7΢#,A2`KYh\L>{L ԈA]b'59_)vj "{sfhJԨ1SYhgֲJT,`Y$W4/eXi$g@2^HB)v4MiAQ&Q@<00CrNOp,`7I 1ׂT{`QuR;葳vcRjmPsơӐ ol7G4$U^82ಗT [(woS"mU%4C 9J/* (h@0v;i0X79YPȮ?gD)ơ^vTNrݪ2BMaF FU ['+ˈR{()|D'M<-ʖ>V3'ZrjQ?a@'7FP,l[)J30UEReϋ| e8? )$(%vBBddBT9tD0Ԉ?V`#Oم? x(i+NHľU;3\S B^B1=:=dX=jVy^ =_,!@"anp mNerFojcG){rVx4F.bHL̋J4vBk9\딛Dm;]}x*BM4&: rn"*˄bU/$k䏂ɟi7CJ{6R}rz<[zj:y& Jah4O,I-/qO,%_uyH2R(ءڌvw¼Ho+(N$ AMڄl[bkVU{m),agn66 9=`lai!@ӣŷ>zi6'ߋ{/vӋ&% 3#Y?]h$Ho;٥k8T\O::.^g;1AsCq~`dN #'*Ͱ;2ۣv2`7y nNN9H ǏA>>=.KqQuJ+9kQHU9%CTt^^]^ ڎ6:)cO 5ꩵjn7nb¯s>8+7}M给㺙 ?@y{gvh endstream endobj 117 0 obj << /Length 2336 /Filter /FlateDecode >> stream xko~ЭIr@Fā]}0u'L$3;KaRqb-gg罳3\q">iw7g<~Fӧ>Ix$,e\(qEup-3f,RQٻ 0q0}'`<{ڤF2.WQ*, ޖob˿?]O Fx*=dri릭k x @83Fke .&.\fM؟f^뼿q-aTѨ7el;ebl؄kn{}+Df _3?"s -^b MmꙀԖE}"-5s[L,MFuH!I VM[PN9w.4\hWҝzyBܴWG9=U݀RU;6CZځ HC󓝌[irȯnٰ8Dh{Z;o:ڔaU`u甄UFK u~#+SEfE=RpXuA1upjk 1`S`|2qT0)H4|\37t fon*/v=sT0f`~W7Ǎhi6=mcڌh]ngcpHRg6zȁpFut+`,d6x$&1Gd_asm$f>6Gwc4KCu S4P$jpģZ݉}ȟ1\<[& 3l} VxW'pxtoqWLʼn7?}6dڣ稧Se?g"ߜ}[}bk(2W kgL RM~jX/V w'e>ОOf[@6a U NƢ; POmQnJjB/vC7Ї@ľ]Q v5 7ԩ&П\׮"Z6C0vM;7=tnjls.cxb3 CeL36>~3W uz5kE<+V5$I=%?E~Z{cwQB ,\-S#_7yGѴ*r%&5/q^Al?DQ߾y9)85O kD2Oљ)!Z)uq3`-X<%VI'> /ExtGState << >>/ColorSpace << /sRGB 126 0 R >>>> /Length 34415 /Filter /FlateDecode >> stream xK.=RW! y^5m&# g܀KRf*UV~}ZZUEG)i_|>/ocw_1}?J1>k4o~)cy9$y|0$t}A ?{޼>$ۄq c.>)?|!~ L{YSq#}\íR\{5α9R\X5=cH9oyck8Ɛr|RJ{>pǐs2cZ1Ɣ㼾}R<Sz~c,VN2+.9> 9]1l}>g;9jʝ~os1=!GKs,W-]!pymp!px )=ǹR 9]Y|JяGkUL{)/@np5hs/3?^Oq0nvk޽m[2SڟwڜTSj?KmQj.UOmGG>Ǒ{yVoW_ZTDUlo;S\wξݫoU|9m}#owjTucE{o=Kyym^So~kGڟ].UEjmKةoS}ϹTwsj[Kwtzm^S5﵂j[>q{߼Z.Uivm^y_{W5ǡԻqxx}\ʓj'T;&M6{mTGe= yME|WRs%6u^.ֿJyUv'z/uyME|-w=]vmT:Ny_ݴ6Q2 s}{٫oQu;uTWߪ~j~siz??[B'rx'^:oyK.>:&y}H0sX'MekB>Sݼ^oߌ:BnOm |>iSiH(>$~ |i. e ]A vڊt|{jڽ>$tSгk?zMhͰe}BW%CB?Kw|PܻIu`}zKo5Px}Hl={`Yj)ׄO^PkB?KۧJw\waߝ.8yH0njQeӷC_!uf ]95>O No ?k|`mY~9%ԏq^ ]K[5_KǧP.;^ݼG&©N ]_ QzMM.B'K%!~<~mry&T<zO]N^o(kBˏِP7yTú;]jؼ>$tn N^ÿ_ׄ~ORlׄ~_:=$ʩ^CB8 /}ϟۜ. :|u'GLB:TCBׇO㇄uC韫5~OyA :>/ׇ8 /}}zK0A}ާwߵisz]01SpNO5MG__6K JNL/^[BQA /}>vICB7=PZuZ>n[]7-5>SzM`/? E ]J,kB?K/7?jnԇA[>F'm6;& ]_U!M׿Vx~/6jrΜ>$t}R$7$A o:cvCw': e^ ] v>5M݈!o9>4 }?}Bޝ8Ux&_ƒ%T$yO0>1y%? ^*X ]m 'ސk}BwCj>6K w_R_Nګ| _HjO0˞Я?O;ӇO> Wv7\>$1$<$F|Bm/}Bg v::$tc+}Ao ~}B?}zKs KNR5wu`|xԟǟwwsJgګ?A ϠZ?}v ]߿?ׄ~/} Jv}B?nȲ'ÿhfH~pZBwu`ݾ]>^o x}HlP!g* ?k>>R!߿>K`~9Yo:wܕoШ̠ -?hhHn_I0$TR }B\L/ZCR- ]?tTmH;O^o :2j{'t}!!s0,P!pZ?ˠױ ;[U o:|Ϭj.T_q$'t}*2^ =p?2$XCB7~>ϤzCB۠՗:]ukw>LIBk^L/!Q[B?SQ?"A ]lT'ÿ o8ww[׏-swtJ럊b˰z;w쥡vu3 (-axvUw}_Vp4&c-y.;Yq^kGwYckv)O8λ[n|9\պ;v|U5OGZ8юҮ`aM}W v@ڱ@Msj0Pݜ>~Z,n(ZԷIw{9O'$`\Wogt<,~巣~6XZP%ӝ|?t[OV?c%hD>o8KIqt?sg8CVyǴEtXk,;2wk_h*PnMݪnѾ ߷e=볻FKYB%Kex 8;j꫇唘W3kZK~M p9/LE?ڸnY,*Sg(b `b`b Ȕ!؃ap-YVaC6=ğ 绫}9yFE>,׊?a+pεWb6YV+#H~putYwxmzr̵ҕm:p>k^]-e%:KpaÄβ|[C@1"VTe,?JK4>CK }p yKB\][AUW:&~WEumYxaarw>"/hгqإ>J^qw_ ~.GER5vK_kϥbd)A % *JV{O d#AV ٚIDWL)+j])4M؄i9rӝ0T6;4r#B8qP%)q0QK\/0T00Qҝr#ϯ^`OxD:!ABP C]!^.r>Tk«_\S>\Cũ‡PW^,C,HHGќ >J@G-w6EIPTh>=4BJJZ{ aIQ $!5!DS|H-OQ#Ԉ5  fI*%K,ID̒THEȇDd$W  V9v<AH- t-|k a>9{Iz, 4-FQ !ASb#cUNIP$$ng|HEȇDd|訏kiƇx(ŇĂP(8 F*>B>Px Y s",)$ 0!B: ’wi$F>&Ia"@6YښP Ia$"fG*BL"!B] CB3&baPBR BoHEDdHETHD |TlGD wPa1;hq<<VyA0l~Ꮹ j0{鉞C=Uc=2]ᾍaG<{@`]= yD0yHDj FU(>P6JM= ]Jk|(BqI!kU袠Ey0?2"S!R\M # S!!(lB d*>bc*  J) x["UYXPPSFԃE-}F2DjPR4ĿPʊ`Xd*BBd]c*4v(A<wS!y1B UY]4SX29j!<cŒ ,"`0{QROXQ6jzA3È "YaFir^T4aFO*H=$(:6ij7DDDe;'ԃcD'xS1H!Ri`d1?2w9ң{K#'xrG<$dbè/< Jfz IhR JbTDĊIRO&*H<@^^l'd؋=?(P\=I0CÈ Ofg";4V((ch!BѽάcLzTŤGTFzrD]=@Ģ?!sTsŴ$z'VQ?8C#B BC+AOw6KA# -Š`V"B"yH抉HH쪋kϯŏ[I,ՒXY,H BCk mD`i% K&NYRsĒiJדAO:#FdxRq:!T(<B'*zX=BaTE*J?pzzq2,m+/lf mC"'ݩ"H XQPX< E%LLeۈ!y +RDJOPyxRG=J8XSsԃ++Av#ƕ8zW  AB=%J&H8U  jRB(zU< Bp5dfi oenz0+1VcEAٜ R P!UfaiϟN$*[m(AB$XІqV0XWx,db AH#zEBbD1HM$\IDȕTk5A$"BM$7WoG4,"7F]AU'ӣHoTŜTHdTTHYL%<!Tͬ,Լ'd=,)uS8zOtO=*ja<mfrpY wUOf0ʂxxe-kd"rCgdh-m*"G=@2#eQ ϓYeY[),NT8Rq:p|P=CNiLDFTFd^K!Df̊ڜdROfxRCiE3UiTFoPoI<)z;/sQA L'(sLG>{*[9״4r&zS+'5-LUʕ`ܧzW#N.kxJdk/ۦHD\IEHT$agdSV aE%9#̊TTHDTGEtPSF,l"(fdQ!44 B*B#"%=bBzPa,+Н@yN_P"̓eeŠ!ŊYvY})$fNS!S!Q jBzkĤGUG:1!=U`c* t7tjz8@) fc2*Lޥ:X< fD~ 1Л& Fo z|=e0g2^ap̓OeHo 9Ƞ>zXD"a/˺zA}$VQ4B"c*d/sTOxz*;i*;恜FnIӨryBX싊%Ê"BXVC-Ab,tWHS fG$FZ|jaB_-Fk B`&B iF`(Zb D"8 B\ ԓ6JIz؎r'EC/ ͓M! JRPR֕6+*+&*&HBV*Bb**Bb*d*yZh`qEA%BTTA*$=d\OlEf4RWPR=lj'3OK< zAJaqEAID 8:+(kR{G&J"TőI$Q+U+Q)A L=D&=b#*+R2S*;fN/Fo`zh`a3^jz)U<2N?:G4*(]!Lሇ10ӱ470S=z"oæVY697Bzc* xφjB Œa/bɰfaEVAX.[l^`D,Uv,"^eYDS`SYO|d^5 {%"$'*Fc.%e#rl+F|ؔ1L0FHTeQ6HQA'HԃlD%Q6YB¡*9 8&'PG.F WaEbHEȊT$ĒaEjHDBL%cIȨ0gDz02S!Q3S!QŲ:a,ŲwΜbjt0yiToZYI`c*[#.$HVfEVz:!(xjȠkeF2r%S,+0dm"•Њaiz2\7gSkfm !(WB+Bqԥ\))uS\I<+⡱ GfChSHH|Uk12Ц֢U TFxZ_{__%I,I5;&81L,l*hņ@X2I,l'Vol>H*ȺERad*8 qd"0(VF}fI D6O?G0ԓ*[ VFdX<6Q=, QB$L=8(^*U8(U!20(I Mԓ'2OULT%s]#!SPT((Q.ے! bh)àCZ5E=AEO{0FSaPAY Faj(k'6$Sbejb=(xmI̠L%)mO T6o7 ilSP&8obԃTUSCTtAJhSG) LL%\)h渒znnJ!\IUƕx4ŤLzWOEn+%[`,!"}7WY^ֻc9 }`?A Ⱥ}TWI{S֣&ex+|ww)I`u/E~}ϦYKyjg%Snه3Me贝6{,%̚}!E.4y5qX){yq\ߍ0>z+klM; )l5>{;KynZޜ{wݏ[Wݸ{k;~/MWe@9k<2L\ϛeJWQF~ssneΕg2gɾs.2Uw2Ⱦ2gO߫2r-M0gҰS1kk[ƻ=e7[eL{ 3xW8Z韻ؼת Kў~EΖ~%ي*+GSF{W-qqZLl62sO̵ۜm% KՙͣLRE2^̜̕͟6{͒Z#I:h|f,u$xԕe/[Zcy] KkNxԕgC-54zӲB-rVm܍A\dϣ- x.(Y6\d್Z.DTe.]4`|iɬ{; Z.0? ,/-G]y.em9NRZ9,๬h ๬{_kߗZqc^ε/r6-+x.mŬ"+o^uPe+o sq=+o"c_dStѣP(͍_=۲"teeE[p{ԕW]0mu^yp˷ՒY6\Vն+F*tG]y-eY,_ueL-؞_l#4yG?TK,! tsu z$@1\Y}{x6J <`YMu-Ok.eps~"oXY 4mͳ au|>[ yd]uekipl ֶcgMq5>}VSGZg)ڷ N[mgQ=;@:>?wۣκf+}xZ 1;  h$掶oa}YeGuxB:1m<>2uT̳>sۀ0O-^7Om-.: zZv9v휘>볮C=-<ڣ{]ڟ[u5յA][}GՖDM21zem6<཮HϏ:._֞<KumnSh,3vRy~R!FԐbǐ'Sp?g>^r=su[/З]~aSs-+{ZO7NsoֆV+k%}нn:mduݜMբ;~#K;^bB[xTgvk 17\E ekno*w_1}?hgT̶>o#o~)c-7w9$V86cLq9l5P1[(C p! krԔr5lRzwc:1{uC˱uQSw 9߆5=cH9oyc[c ).!α- |!p<^gc )=;󞖑eCQ!GMs]CJqT ?ƘsAcʝS|!:\wRz :j S\:9jQSluS,zՀCR{OC!py}C1zzQSʕs )=1.R1{zn>XRCRS]R\0!GMcJ~|?ːsW{9ZJ:cRzwcܥt R\cZ1:([bgRzwdz?1A;Cr嬑6.ǘsu 9Z12z%e45N_(p-_w.>\^N ?zM0^ wqtkB?Kuݼg;ρPthGlL)90)cЏ!)%U#|sL!|m[ۥRznC+,gT|JSz!GKqe)=Twc9ZJyb>ǐr,eHxQSo9ǘKd됣DCJ1Mxx55).%frkr )=G_CRT9c/GKq:џOV2R\cr RZ_"}s-]+,u!GMiOD>娋9jJySRr\>娻9jw12z>h).+K:h)CJqkERz2z6h)Ý>)~sc䞞[a>GKYS\쐣DkCJq:p2:\·5 -tp9ubLq:Zc5{S\7):@1{CJQf9zQ"9jw1\!GMq9pTvOCRZkn9|J9Jh)ylC! !GM߂r ):@1A>s#!GKYiغ 9c-|QSoyx*Ӻ5 eۛ9jRӐcHq9Ɇ5_=)=-eg-Rs )LoVߐRt*LRz?]9|1!GM)oP9N rԔ~OA1>S1z[?[Jt>ǐsU}uzJ.ǘç ):@1R1z]u|3 sռ-EZc!8VRگ=1Oq9&,R9ǰ1cCG͖R9|1ːj}scCJ- kr>Y1O9γwl;ZgC˱؀үxaHq97WK_!)1Oq9>8S:P1J|:h)CJٟ9ZWYWUs!Oq9>}0֧98loHY rc-7rQSus<1Osc:Oq:X}J?ˁRv"zQn6h)?H.ṡ)ry;CrRjHq8c> t=(OiI9ACw1RڗcskRurR 9jJkS\~ G)=~!эr )=Gdh)&!Oq9ܗSo98)?+1Oq96Rus kS\ŧV_>ǐr!w1NR1z[񷴔~ ӳOZRZ=?r#>];GE}J?ˁ߱oaKYSݳ)=g.Y|?>Oe*9$@cHq9L!GMqywsd!m16AbL@9ǘk}JiSzGE}WYV{CJ 5çs{):@1>S1zy9ZJkmݝ!O9ngrV=7?S\ɏ[@1~|>ȪOq8-FçGV}WYaR1\lW<7Hsr )=}eRurβҾ2A).l##CJyhw 1N&jՓI6N/wR^`! 5s^>XʇqԲՕ™Z˂˺Ե!^Z˂V1zZT`Hĵ.JĶ[t<WohYRPԭn $e,5;sz,-mͳׅUw ,~KC],#w]sB ~X%Wy6ւ3WK56JNն)Sƙa=7O]]5Šu)X<[]0r o; rk HYz%o,w~M֡e1#y(B"lF` wF6UYlF{PFh,û-X*?L7;Dz߬wko?nX<{]:SîoF Y2d6AB 5Mpa߀BMpo' ioH'u^/b'0 .'jX(< E"bXD H,`IE`) #B2";`Qt T< BRDHKTKѵad*DHxo$`~7*C=BA0"BC(?zA(XP@-a %0C(nBG; 5psI=7)P#h hd߃M TlSJ=Bϖ}BT"h*=XJUH* DTL71MQ/&S X z/,JCQ!` s0v2K˘znpS{nc! b  7]CpS3{7!JU T% hmVSBIwCLTtL% ƬB*0&U 1ƂY=cEc,S B^ֽ E+XW5 7[*0)!&>nb! 5 Mo!$bIDDD`IEDdHU`",REaj< M< Ɗz,($4.CbT%UK&a(zz V<  9C`T=4b 竇"ؼRE( UXzOBQ[! m!)x>!EHh3W6VCH0$[=T4):Mbd*cVEAcRcc!2*TD%XHU"4b)jR!bZ") !e'7WAH=`)4b!ETTXTTe'z^)#zTŨGUz`$vS hD Ԩ Ad WA2#HT_T%EUYSPA#j!@ %TP?V- `̢"AX| .1fQT%# TTDDNT$:eSǘEEYpGF,^ILRC2h\< aHuC ̙ РHC$!u1dPzXTO{2Q=aQ=v1[{kja7;5<Cj y ةE2`yA(K<,6C@MRP!&z>,VQIEaF٣xb0F=x#x#Uq 'd$ IUz۟BR@'25d 2ˡ($]R@@D!'xŧXTTŨT uDPT-$*R"SK[;1U< 0z|Aԓ/akXqc' >V ~C20C=%FLhB#E E:zQQ Azkd"u@Azki S!Q@UIN)LT%:A9F]= TM,9Ki>% EY0,Rc!!LUo6]=An%XKC%4Z ,R`!8, M,,,d™ҪYRH,H0,͒QBɧGBpz2XH=H0,a!AœY<,~a0,zCzT%} 4<R< H$6 69MUqZ#;Fʈw!bBXԪ4Z(:CHQ #$Sg}Hp LqA2- A R@ih3NEp<44`$*Kb*Kh#%8dj2@*CHѪw"1B2GʰPP尐B!X(?(Bk'5L=lYV&"Q,Eh[X͹ n,*۟ 3)`5rĿBAHx߁"$lyBa{mX%HB,śE!gIM" PM$JDtfIY$D$"K"B$"YHDQ b!1RZ=l!4Z!TTz QS!1U1f1XL}R5zRSԓN. x\hH=@'_XjyX<}ÖZ5ɬ$,x`شO*&G=@lLLV@4 fԉΓYj<,RTHV:pP< (CP jLHFUdnLaHfIJSROfxRSCjECk 41M= ߠxRF=ly^ CNPB砎xQ-xR+8x̤,]PԮzΫLRODAԘ XbS1P#*8Q9{KmnPyخZ *K=]bg@D=Ś͓Q/J6zL%Pu~ PݧCN52݂tFÖ{U:(<D;:da3ӯxL2:(<꠮z2ӯC~ROfy+Mf"l]-7!H`b,K&vF-Q X+4E,tUTL Bhl@-,$D$Tz`GE< C=V}0mP '3<%C"Q1,2m:SILRBB*C=(<D׈QltczT6!|SttyMH@)ϼN2CNRԅ=6EkAԓ1:2||1DW $coR/UFK=.x2SԘJ d@zp2[ÛؙQOb`Pc*D2bb*,VځO$VQ5&6ER"< Ԁux̓5!FU jD%FU jDͬc:9!P'hP9#W uLex)5!<=C aP'1quLeqA3@'IDĠtzU&9rL, l;m:_͒:b!@,UyB"`!'bHE`,tW-~ ڪY2kb!!"vk6[l>*OfֳڼWE6~|UPEIL x,M=`sa#(%̪<`T,l D`TT%HU/$(,񰸠0xB̚:a ]CHpJ,C쬋-ԃ!ʖZ/EAeGL%X(z)B&&p'3<x2C`Q"mCXd*B*@*hSVaX(hc簐xXNQXX_F`DIlnsgd+H>$`VK!]iŕ&'`|v n*MA]McpAx 8eJUL`ɨ[i?^`T,lDİ$GD#"A^z#uHJGC*b!bfK- L,fIA^Md6–ZFdO,Wb}Te۟pf0|+i]2PԓX><,UGa6tԓ5T#*QcU fOP̂!{BlBaSb8LTxHTh 8'ѹz0|1bSٖ^iN 2'zz0P1S)Ojz)RcC ۭ-,} 8f'YF08FTg*D'INBb*d%0'#CT8DT6IbՎO/1Pz2Dm;E <=z6\UI$@hy ZZAȭb;DaŚ'xdz R S1Qoj,*ԁ4. `.pV0XCb!QB`͂af19 0,%Ă,+j!H,ۧSH,5" ,}(d`QXd*B2+2ddCSO&JF=8JFT LGU uLFT͂옇E e:y $I쪥`ũ*jf'Cld,l DevuC`Q>%QW$&l$VQKVh( W=m% ,_fj]`d*AHK%:ً!nx^[{"\MM2Eed.G< ,w<,K[BKAiK/`IU!R>Ɂ%*!K^:řh!$2EQ;1zh =|g/V"z"T z0XR>X<$Wp1;j\f b!I4/"T1s MB-1$v MvB R2Z4 _EH뚾aZ0Ԩl ?C$ CS$DŽfI)PY2{b, 0dF7]=lm!)܂M=Bɬ-d4HI wm PX܂m:dVP(Kbl0X ΂ᖊ8JDK  V>'1`?_0`fm5K%3IO,cBY(ƂQ=ŰՃ1ŰՓ<OU`7A< MADnhah 4LSOSO%U1X]Nzn `Z=$*, d7',Pb%*P|BA0M KSCT^UASA#&z)8EG< MdLӶV @:Il[ Leh uTPQ4zBASV2?<ŠUnܤd5%U!B"SPCPzB")xt<ޞM-!$8 vq` %RvYU΀%B*+pQMVѯ%T%)hUH:MR"ݜZTbXaQ-7ajaS@A+# jI&u@[]- }baTvRah*8 qdbє B!6[@ 2&U3Cp pm0O"><BJW7%VM4*H(v" 3O"J=X X є By~jqb?`e*MZ˲i~AaBwYMJꠚ'eL% u jL@(aRPh= :lkPh<BeYjz ZԓYd<M!5CpZt' H'&z023B(S=&MABКzPen~DS|B/0]9P2t(n&S X Z)d]e[ev1X2%6M1'dS-6n 7<C*<B]wa|ՒMBqL-l–S i`ӷY==`'YnBj! 6YBp8K 7&1XR#&2+CXB fውy!qL@M 6C! nRMbd*KsL3K׉%PKѵ1VB#!!UEF $>*C Mj͓X<4%T%o0.y:ժ0TVّ>,as'+kм $ONF7N%}lRau{۪ŭSM:$cMFO5JhbFwf4Je`%\(3݌(X4u*PSEO J݌bۡ7\L~3urv<}Ҕzה~ʫQ3YDi2KoFSM:͐INSMfii -v VR:Dj}a i2LXk2ad+2X/FNdCcbFO(}UJƘ1@Ō,Xݟ/}凿o'Oz?7c~|?>'$17ؕkؒ pwX; lw׃ y/0_tٿ [ ߹W"N p ^p4V\Ɇ\CՖ5b`x_"MQ lw鰺Y\/ǀ a7C^-~nCD1"ĥwB  v@"AQ c#(69ns`s6Uaֵ좧ks,a*9\QEHUֳuS5pWXyczMkoݿ\a:Ͼy9X׆nVaqs湊`Vߺ|L/#۾iC߷e}skf|"k=c}ΔW^0c=>QyYu7sTͯ3 J%<%'\\LK5~?Ŝ5ސ$`+#\2#1.PjGtuY)Չɲ-GoXHv6RTZld*٬,XšD]6Ɯ;L)X 2eK[Y*28r{T%)Mckfm›WU(';l.ސ*Oy"Ź+uƫP2X͒aM$e㠳_OTj>>uvs=UPXHUcyu9{HxSŬeJ4]G T1M7$HmDf&fgVfFHhf+7F蘌r& ʉKs-V0)3b6ji8fCH-vxTTLE#U1P?1b83e\1R3e;#KMNkqᝑ*AigĪNf"ZEvFwf2VvFjcKK.0Rdڴzrb 䝑L;#U1QE3R-3~cg!fF5HqL\xToXwL@~gn&H`*7f2 vƧSc 5L#D`Վ#"2Q3M7Q3R3 U#41SP3R#3Ceg0 eŹ=jʟKAdo&  A]"΃,R8װ"#͊M\ifNk檡u*044 O{l/(,P4c뼅\!Șe|k]\ϏO;{zlvIs]ybBtzlvIsMUs'6FCL\`(՟0I X+΅+ 5Z ;Pu/  endstream endobj 128 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 134 0 obj << /Length 2288 /Filter /FlateDecode >> stream x]o6ݿh!)s%hpⷤ\֫>IkfHJ+ɛ1ഇ9Ig&`k.i" W{biF"W;!s_߆cWl$Uя-|yT|d\el3]ۋͯW?? +VBSlVb_C1f{l.mb6΀CYܣ{y]!a|jα/Y?6PY3!2hy2Ml>+i$N,@ ,}[U} fz#j(oCtǦ2|nq}k#M1:#Χ>v:Cх `d5k=tɑ~pPmv \ G]򨃆2HqzE|4O mM}7zXFkހߤDS&mDiv;8z $ڀO` Y_E{} EDjՌũg/f+M( F0b<,(SjN~y uvPT,AdBD_KͼH폍]Q~ tرJãRQV7$I,2KnlYmU< p4Tl 0 o؞9컶qºR] *p䶣U,>`` :50}u9 'YJD%pd) ŃeD j &bɧƞNw]\p*kol(:$*_= xCBG=$}x屬Qi>2Gjh]53{(%˪DgLѪ@j&=1N;㘁(d3XH1<[]]_sتX{v·n]ncb4I]gufup0OW*YT_'3+*@\O|Guـ=>&&փs =9HI)O5ƞ/ 2Z9Y O j!.|0aM!G,4_\Q?#Q>I$.)l- ;~6?aƇǬ=>@|C6n`2Eߓ k4c`Z12@ZM.3ʁ I~Ne$\B a0P5$9NV^l0s=Ĺх>Z@rFaLťOgTp02uv^LK\J L,Fo_0'Lk6jTq{^~3յDPu?V/pPZT˓XaiM`|!GSDph,DBgNeX;* '6-ҧ xڭ *bXt[}A`ZgrɿYfxnqc.są~ed]HAPH5\rW;#p;i8 1}Snf48 R /#WAOfDXCh_=qp=? zEf*n (+t{X n|\]HP™x"e"0 8ēc9*Oe"{%Snfz!?#Ka> /ExtGState << >>/ColorSpace << /sRGB 143 0 R >>>> /Length 3880 /Filter /FlateDecode >> stream x\K9_K6#@i !LHD܌~>wTsX}j?vU&?_|?۾rqlRg۱El?/"_ֻқvfWn{݌مZ9Y)ˉ+k˳ufA+ڃ|"h?|rwpynVr"Mw|"n7'v/q9;D@Zh<#߃',y݄7A%a( "K!.AIG#v Fd ٝ$"cZ֐:#H% #p u[E @umniS"v "Kn,A Bt-D{?t#Z:#P÷H㪂J:T%8̮A B4;nꐰiR DcsлxQIGKYZJV]GI#.A$RDB] @1aBZװ,T-~ tD\4~%3v {i ~eO ~#ۭs -)VTސ]3fm9d{X\$II8ܺ팄YZKO0lWɳq_ّKv*yvz8qά{(ZYE*-=56W=u:x '{ǩBiwA>N it`^wȒ"Xf8Y€ C3z]ft1% M2F 29@˙z `d*1 L2HXo܅M˼888J8 ¿xFwTR%: +uYe&r^}%mIƧSr,(3-҄P8ZKKp Bh,-lt5P뇥<\t##<=p8V.xùpXߓ)LS8,=)p8zSGOH<)x'faɇYagRaGK)FaɇBag;aG4™\RAΟi_}&鮚t<꠩3O즂Ooo_ު47js0Hfp ?BxlVw'[+%N|T+`1"F-9˵<+}hnFWrc[96>9:|kXrɑ*= wˊC+lj>1rtzd^qT;לJSܒG;ʱuIZv!,8CB 搗11k!ލ3s^Uy)uL\}!-zASt5NS%L\(I4TM\dU3s94圻}n圓eGQ=r5Ҩ1"}m-Ws.qjeJ^+seD OǎZ͹IC\qKM,Ƨpj%M8FۣV66=97yh>7 hŜ+Hs1X9s-}n89ݷ}fQes5;VrsΥ{xŜ+蜳fqs,q'ŜEjUj>$Wt]]5|>u̅+ ]'GBc3e*]!:ݯ-3^v*=4:y⧯"ޚM{S_;~_~ϟ|/o$eaII2- ʦ7K%E$H1A$sA$:t2#PŒo!yMT[, vu++Hv Dohߵ'"AnP=,**AV8ƜQqEcJ:glP h%futD@h"鈞D%9!#P{uMuIG '*ڜD_:򨨤#PC:8nx۔J:gQ h5=G$ @2uPIG[@K&IZ"鈞D%N !cYZ @tyR9G%3i$&iy5 D,@  hNT ;!"c^ yTT[8<**鈞D%8ND=7vCiu }m ½O$2p|L##zB!JX);aH1~w} tDp@V {.^ 7H)93-9yvZH)*sšy*v& w ]5e!8h iA- ,'LJLSGUb)R)KS&tf^U 0[bɸBZ8o'4VYV53pr'YHgrC_UkApfRUtjuUN#Kl*fG՞vYE3kBb`U2LS2kJQLgpZգ2鎁㸩N䮾xL3Bߪjmw}b\H[xU}@\H.{qy]\HKkLS?4%֦JצA[W\:* fjeSҪ`Ӊĵ*ӦU*B2O5Rq=s,Z\[eq= 3oꋹUNs*#*g򔹒[JB*|Vyh-Vy8\ͭൻZnwRnCssT X,V*[U1xIvnU~ir*|C*E<ĸr\]8rYu++jQZre4ݐ,r(-z(-ċr(-,J0]^8}6M:p4!MW7d❲>833/ fT+33ьj}fF@f7,oRB!?tBJB+] /t}CcL-+/@= endstream endobj 145 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 154 0 obj << /Length 2212 /Filter /FlateDecode >> stream x]s6ݿ{05`K:M&LBPIn?]DEJѸy{ 3w }~}rNL␇a';{s:ow/_Ekd2ᑻL=w*_%=7ko\y[ٱUaAUn;5,&vzL0Pl[eCH}_b2AL܄ K*`e:N0-(\t[\Mxd$`W'HC@v҈v$ zn1XxyD<v?Otc; guؠ[VSۛ3#l(#,āPC7 13"hhFemU]V5_z*T9m3Q\P_DX(ri:g%HGIBv ?TF"WS55t6+ŪeVy(`Cx~8ǎabg󿞻=/O~ǜØ 4p}FN sjN~z*#qٛ(NL I#$YC3ukaNr?xEB5$=P^ TE?]_G2~ ޕDfph 4ae2Lsղ,n\Y*͒v\JZ ń -_=I.=Tef՜*6r8Mڕ%0rN9R׼5LOv-􂻬ZfEO83D`M+&H# KX̃>ي0)=C1<0xƥEסYYjh$z:m@bQAr<\ ǖ*d%[A*MҮqۘ 6z`gdۥ\N|i7K7p$D[ƒ4Kl$xS=oK7U @YrZ2ZD:Ui肎_mؘgwzL,eO:ܥ"$&cL7v=;v!fXL),ݺE3=c8A5K"IkYg`ej&–]-pҝ^4@d9WvUegZt# l-`M?κsiJNc\m0R>"kXY(M :Jui;7= "#=cXpBtFlU&ڰ?$_0SyejvNަp`C[eO f|z߻8%3d![3`!x鸿 .*5%Lb+ ,2'o]t\GCFy>8$i,7Ž-[uBS=e"8 E{mUmk)(z7hA]Ec1;|KۣNʯI$~0<7 56s  ;ӇXE*&C{!8d6-A}DaZ՝߰ X-<`DpZçCȤR3{m.j?{}.OGwaof>N ߿cԫѼj_i{_=\,P$T*@="BfiW^mݬkPfB%b})\{svQ Xme9xU?AD 7iB; yeVaL樽S2ԴDlAhy]iIN~op5_<ΗCzFPG3ЬUkGZѽ 򺿼Db,"aX%SgusSwVx=iڽs߁ P'j9zj0cAr lނv{1:_$܉9]}XXL~{0bٷmL{>%i˺LIUXp;AW/*XبKs(I Yz'v endstream endobj 151 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/home/renaud/Documents/projects/NMF/pkg/vignettes/figure/heatmaps-coefmap_custom.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 157 0 R /BBox [0 0 1008 504] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 158 0 R/F3 159 0 R>> /ExtGState << >>/ColorSpace << /sRGB 160 0 R >>>> /Length 5611 /Filter /FlateDecode >> stream x]K]7n8Ki79KT\T%nj%\E~|//B-5> ݡ_~Oop^<Ɵ?|?q?= K bpŦFhϭ(;>'C=Оs~|Nr3B{H-M(5=I`/.3B{%9ċsF[>oG<#{,_$3>g?թ.ƍ pњmH{sq4"N>^RdDɽ0rpJpFt J05`aK (CKQ:0s m0J0i( 00FLmx6(chcS:PSNtdDɽ@>88e3(#XFF.S68s ͤS ӖQ:GmQ2Nh/ ] c2p K'9c8sdݜgDEo8ep`)Yhp2p)#pFxm${9=kQ:GocIE-t<*2d8ermZ6ems 2.pdK;tP3d8em0( I%QN JȻҌQ&UyrF8ZWp?iH\ Xs?6ؼz~lBt?TpjWoMx=Ñl p06:S5r덱Bk9nx6n8a]:)NtU||lX12 Ac7x81fw2yl̑Qd mv8폈&6[X0G[`cl@HXCbKN #9!9}b|>71,k ÂB'˙ G-o>1^1XlN܋V?kbàsc'd fs$W>'Mfsa8?6Qޔ|o )Y 9#sP)%mDiEOG9]sYsGYsٸb>pǞ^Th1vI)YG\`>礗" 9uSň>f9&ux c׍^l v8UG |UV58 =ј[ 5$Bm^. i ?秹ϟG:u7mDFCI"dj`11JQQ^Z8ur(G4r9r06emc489z)&@-Q: Ԇ?68s6f Nu+8%ehspJ39r(JQVq)LpJ/9&FF8md}dm0ۘu!0J/9 f12pt96r8U F8z唁UqJ8 8s*/Nɒ&E@S^<΄5c/#em̺OT]F8Zd(ccn:Hm0Jژ|?fo^sJUupN98sJSNA_f9z(df8e1?m0ۘt9$LN82 X>^S:Gcn#+Vg)chch1gQ:GntAޝS:G̑E(ccn#(m0JدW4O vȽ;:^]=OBg#D`\"' 薀vaa1Vxw+Jp_(4% RSB=#bθ+9\@7cpQ\uڮC <BA+ ֢H"(v^RBX-$Ю!Aq잀zF ꆀRʶ yٛƂ!;Ю hZ)jmVĂBܲAi*M')޲6QB(1o vE!{&F oz6+.nV6B*"P؞ hs Y'O:9oM jw!9‹z~jj)Ut^ :0?O8BUl^Tb钇yQWXe^Rw؍!iK|p|T߅CԼ.d~nղjK s /̋J$CpVü83$MQ)HӴMQ'=oLrOf/-XPxv  Vg#>  t7 ϋE`_jNGQ!(`Ss,Jd1P 7 Fԧ$VP3>҇ `OlSH[S0K}04LTӧ`)ɨ-} f!{+8b)-}JjƲJ(rZVӧ`VPG C9DT׎TJxYCS|ӧvbc_|)-=} fKtۚYۉ%LP9t{̖>%GO,\Y fOҧ)>D,\ OS3;[[lS1[zP1K=}4Pނӧ`)-} f"WG{JRZhY:r*fio 1#fTZb-}JNs fB(Ոӧ`)-{+>cvS0;<>s^(-}*fKvҧ`vтӧ`v뚥YsC)`ٚҧ`+b#fo~ FgJ&HSC"5) k$X4rڭFA *|?=;ȶȢf<^W/-OEyrAWZB7PyN3$ F@YSŹp08C`κia^W$ 4BI0" N0~Vf{Da^lEL'hru1^!V^^!^>*WZX 8mOfPEB 慖 4.2or&Zjm!V W•%ӧ>#X;.4?=i#IΕ6;CIBaMG IhitQ\}DQ{"eNw Wf^4H z\glV:LC]OAv?y&HI@~!-/@b[׾X64:^GU)bl/'5:^U)Bh夠F;;Îyx%KFhÄ/{hØ/m% dbru% cdaV?da6цI_2Z1Ahø/m]2Z1QdaDkvhÈ>0ъI5 daDkKFfsrKF Ɯ+.m 6KF+F|NdaV>'}W1+.mI_i^phì|NdaV>'|o]1>,b>']20 .yhI6礛;fs%;fs% 9ъYse 9цYth,|NbV=zÈ>C_2Zξ E8HKF+]2Z]2OKFEkG> ~x`xt<}GOo?Cnb;sɟ|쇿G;5_*co?8~e?=~>8|xǻz|:S`>AhU endstream endobj 162 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 5 0 obj << /Type /ObjStm /N 100 /First 800 /Length 2383 /Filter /FlateDecode >> stream xY[o~ׯǸ~ E{hvvnFT~,ɖ%m,E!yws0ӂEfɤf#{9~) SVeq%21TL;\4nj3c1DɌdVf :e}`˚Ȝ*.yy'~\d\@k7r@-e@ ̀b%@ xel0 )^FYUyH `AZ4 @bHiu7d@i!#Ix-HXHL&=ARX6J7`RR#)^lf< 0&``"ADVBjAZu'1ގ?aq)#к$SWĉC`IU9Eh Ӗ@ogE!E" @ bh)؄fJ:zbLI bHr@&OH,` \-nH8,@< 0GٲCTqt|̲ ?,;e/Tte]qyľ~&Mʛ2Gg&,eV_X0kVWg.j6u~ӲI,J;ai,G1fMb'uLʢLUǮ)o_ϰ<0_mDw[͑Uv֮,8yRZEY]MzF_a͜5yuX=v#ƈf<`3poWxIUjʂ}^3K)(9e Jnp?,8զJ wFvZRFGmX3`#騪nn(2+h -F[nF; Vrt!^$^ }2ri}Guߍ}2|`+e4{mvcQπE\Bj7gp=m=tf`GlwX (<59@ VPXD ˣ#z+(BZ[bg NR?`!JǁɞZim~?X3U(\hVEf.2m T.256[$T`wZ,e",EZ7/Pg,n߽y7K[БF9̵LҬ3)Cf](5t(V3SdXD'XAA9%_TBFFji;ze7śso>E~u7m<+RCo38Uӣu!I+=)ܼMAi5ue`7u=o1{wrBSxZ׻UՖקdq$]լeЗNӤl\Cm[fWM5ey1RVM1Lm֕qʮI(`l\bl3j&Y1w?Ϫ]OYWudENZn]%DѨp}x\\ H*f +Et:j"m:飂yRj Xz!}e Hyb!y@^] dcOĒ: }%Bhw C+hh>䢸FPqȹ>{U2D"z- (^E^Ak(PKSO{S]K{%{jU{2]OS<)ڇi>5AsvӰұߒN:vyj:e:}H>{G?K^*;yq^7_9:'S_uSܣ, mrۚΏGNx xO3V=W6bwB endstream endobj 172 0 obj << /Length 1831 /Filter /FlateDecode >> stream x]o6ݿj+~aV ]AX$$#)YV,k $y<1BFOs7BCwESŝ~ƀ04dLTW3K4N( 6fgwbn;1v#rS `Ϟ$!"+2%sɚ_ދ;L 6BtEH|2#F4MSt! ID'AgHz2MhG!j*cb"rJ12 3a&\Nr>^N5ZZC|᪷(j9@Xq=vS2;}jC'= WdKRAU_sX!*$ 2Hl@:(e-Z/JgݶnuYt~ˢݔ8@k*?Wf!ySe]aj"v=6d?a0]g*7bVٛIM,mΉH|!%-#/򀦄JE4Rr;i_e+n d!+"^k]nV[?2mWzM^uDY4q4[t/cxj:+oڢ=q݋^W8l˥.^f*^EVWCԀnΣ|8M߳{9#&cϪ(8蔐;S$4Le84kQ"Mqcff3.i|lP Q40v]R[hΝ-5#֚#unɹx/\v>ͳN!My2q:#SI$u4XL.TlI?6O偮f!_,vQxGC%&QppHN?:BYk `.ZQ" N 0!仅u8ټWc$NXSn+=xm5M?l50Fy3>Lcߞcɓ#4VUVԏwa)5)Xl5bvR׺}8 ;瀲hK]_Ff{n7'vkBW0[ӌJbv^UdvT|&WԀp ԝF킑&XS.VԺ_zk<'NG7/<ϝt&'Yq}x>]/V/fjMԍ^~16% jzhx\/b{]&k\мn\}&sOVtJ\S[Dp\#myM_$^|[KOoW`Q.sS*)VKEp qq1P7F b!~m dlnL&,}S'£ endstream endobj 165 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/home/renaud/Documents/projects/NMF/pkg/vignettes/figure/heatmaps-basismap_res.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 175 0 R /BBox [0 0 1008 504] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 176 0 R/F3 177 0 R>> /ExtGState << >>/ColorSpace << /sRGB 178 0 R >>>> /Length 15016 /Filter /FlateDecode >> stream x}M-P9nJڞ%Q{Gl@w{*3S{ r*PݸͫTfK}Jn߃;QY)@v %oN>|~CkITft]'*3}B o2j幦O?ܷ@K~sqSDNjwNvGK@ϓ+ܳJTft ?JThM>)Q=|a(nDolݭ$*~3Z?B7*>-P=5|ݣu$OߌhߜU{@7DoF7t9B57Pf.V[Hm*rS& /t }~sSр #+ ]x|]d٧ƥam/1ɟ6έр<. ? Nh|cOX() W61&q3{ 8a+,%m4L0Ih|yX'ƥaۘ_(+WS቟4PҸ4LUh07c$  0887ϕg.M/ǣH\&`$q4poy. xm84L|jU8f/\!KdҸ4L|R887WF¥a5 YWgX<D6a X|(%K8}Ud]. P ',& “7iU7K[]8 Iho|(EKw19N?רʀURK+Ona5xr( ̟]\0WG20~R%Npix.Sh͓;io JNҩpi`ܹJM¥aȒ88oGIh+Oii\&P87br3 Ծ¥a' yGL+ϵ _f}s7Np nNN oo@حpixrk _ |oپ'K xILk~J =ge? ̟]Gߎ20_8fOoO,=)\ȆMd)d*q4ps& X>pi9UepoO$7_G4240&8pr}$KےmW8f_O U$ ƧaYߦaz a7yVZ`2 hӡC݀[›ƥ6Nũvc~ |o\4]'Ux=2Xv٭ʏ /Aĕa7@ˢpi`|2?Mn?ˈi盒¥i?o*Y0QMҀt*\&P8o?9n]&fQM@pixJ&q?2[Mڨ{{[USpAtΒ )5#唔6R*waZ#( Kܳ7)<) _HLJ1B)I .1yK0%z&rSt( =Z`JBC@dxU^UP mA9!BĿ .k;EM$btF6[KN;rbܰ =>UNl,80cXՁfhy+`lg~CCNs.aZ^e[2lĞ$wmr'9s(6* ?7 {ϺnQWSY~pIqnPZBJ'}iUzF-ۺ,JzB=(4)a`Sg#${`KE3jFaE=0˧M~E=0ˇ3B5xoTkh1<ۊ撪_mcژ[ÉӬ7컯ZU_CiUC۱g~%XFȱvt/n 2M{IwoN^Hr~uL'#'kW;'J=՚ߺVJC#Sk=\>7=rꁷ.{L>1W'BgP֘ܞ I׷ZNIfXl0Fox?iל @OPwL[qn~G)^$ߺb>!ڢiw]ٶ]Yt5[<'Q_ 3fZuxSq7Glb[GjN.YͮÝj$rp\Y ǕՌs|Y͘ 7!kGV[HGV[';Lee6nj,5&ٲڀa[*Ar2]QPc ٗI(r UdAr2ݰ4C$?.PYso[WU9ߨZі7q(\7`U9U~pˇh^1h1= SsX÷G~h+8Q.Vz-K_UEd~M!~U#s[_ˉoRHa--k_Ӆs9n[^hL6e8j8"*HU#.,.DwzǴBg5 L*#sFK1 2q%߱&:E} qĥ Q@ aܰ ax Q a QL a Qܮ ax Q a aL Q a Q a VU UXTÐSxS`WLGW0ShRàQPPý90O5MLLHKÀJIH(H`Po(1Pz}5 et0X1 Lt0ܙ1 3tv@=. zH`S<`$o I"SQ\aa^>=g H0HgOvu6Fs=2Ι\ncZs=00(0j̙aȘa=K0Ø0//@.x-ð,gZfE+ja`vX~=?7Iswnn>.X,lHs;֯6< |5*F.ڰ:_8tQ%5b"7\E% 0DXUwt6BNcn}sN|7 C8*l9?rTl0s*o}3?r묃p :9$8*@9lljzd˜y8*98*92Cv_|Wc9;}pvc9;ʘ9f_lsv/s6gG 3mswR㶹Rsymx?9^3B9#6{pno51kskڜ"s6g9`98xmxS9^3,{߶bw9띸9O8mz9N^wf欳K9s8m:tpqp6gW͕sqڜxu&s6AϚ|L~bIns鷠K: 2#_K~n/E{;0֏|XkX}ӿ?LV??|m_Smֆ'|Qehx{I{~'Cқ!'C;oy 8#qa82Q87_07lr'w'qa`>K ?. 8 p2%h ֒sk S0s|2Sf/\A'n>"q2d-pi`<'ağ׿,ǹ)\&8qH\&` BhO+ ݹ%. '~ 07o[O*ԯ. +p2@p{P0qД8ǭ1 VyOyc|]/q+m48~"W0qP  haxN$N'1>9 t'C… N^?O*C_oKw+q4poɽ07OJFCPLemT re"<<ZLx^/zZT"< ZD>k$|Sze^Cx8tǷĵj}hiHA꽏 Tq/o5nq a +Tn!-cZf> 5mNȥAk eYCyEJe]Y5,#VPH5HY`tL6de^cL慆P e'@xo5Cye^Cx8]{\}Vܭ^T0Jye^Cx8u TCyVPgAJiipʇLvowVdJ(x偖y a˱ՉP*=ez+}kHlHʃ,4"^TV6oCZGki0<׸MZʛ$"x\-n Yo"<6^(̇FᕖkL{Mx{k,c{-==]ePϛ7CYG+-ibx 5DkLlA>Y~-}Fw͕ex^Rk~_f^-7 I7trEXރ=Gowʱߓb0(x&ʓ2@ w@zNyàs=z»_}bk#R t zDJCeey5Θ}fŠ<]:~bPnyqo_)vu  "ڞX: '=ueQԹ%\:dp(j8v?HG:ͽǷ(FCj=-r{覣aF8u 3gk,oc|dƆ:E+~%Ӻ]x-ר~Oc>%Zc\:9{QEIEOch/( |Zs. 0ٝh ƹ,̩xJ٩>9Cp]'0'[3ojec%{thc:7K]P/g]qrNn-QB N5ĭ҃S9fk[.kg}=).XѮWh]w qP5 usam:937[<epͧ3 3Nsk֗dwsƙRCjwEҰݑG"68;TqO+c^.H ٮr~\qd,pjj[Шg$>Ls#.ԧtUϛM_B1O3*]BZŔs:sPL>S<):mP)7;ŖœlKi|bJibKi cKi1(W~WJ+hf%GJ4{SJ[J[6MGJ[)MO̜\2ǔxq[`Yn)زkM c l\-@e ltlm΅-1npl̖cJicF4rhq<;pET9h>xp̼٢@myly^2ǔǖ=BZӱe{r1[ )R$sLl7[J[fGJ[Kia,4-1g-ؖcKi2u4{C98R-0g)mE*sLQOJg )e+Ki%s\)1R[cZJz͖Җ-ő5E3FMyl;9:}=f5Pؒ5P[Ʋ/2`e VSI18^%\2ǔF+s0CaƉE-EY_a(=_z/Os81co e|9e<<`'1%{7"- _2fI^'J^%/oSׅ嗄f,c[ҳ-FEeN|kQ\ːVNj"82mO{[WƲnevǕXoō-n tfZ2X֬x!c^1axF-n-F!kps%/^rv[cekX2ruX.e,|#cҐŜeF=l~D?al?8nD"uD  <~ n_} '3,LyTjϤngu}qyx.K/>FN='2@WcF4ႚX|F3 @@T8$#*Qj S SoҐj~rAhj(m S5ׂz5Z%s3*|jS֦Rm:(0N6.oJ=+ӆj-|6-P#*-#~5+#ϡh_Zx)Z%S Ufj +8TU Q3ի3Tp+p.:[Q:Gp[/ZpոaEy)Wpo< 7u{o n>qQhqOp ?"]]xغѶM5an&3szgPnD|`S0fL6\5Z/6MVVGQn2Q:[OSq WM}5snN ? OsW+ ;LlFW,jdun;ƴ;rldv0u}ޝ{Ne\x8f9έuFtJǒa gu~9~;>p^r9:ddnQVs(+^bS||7&/oRq(JC7u^bS? Jš,$Jidgţ,c%P*'ˬTlʪ\P8UwA/̆CYݾCY[۷)9I3Gd*o(X*6e(w#EQsS!=KŦ(?K:+̑9GYCv(ˌٔp߬=do6?U*.v^\5,oTCv(ˌٔ o ;yrE2$yս+9GYf̦,vF{Tʪ7cؔEN?(9Ŋ0KŦPPEӒGۧ# bؔ1P\؃X*68]T(SBCYe̡nhbSM?!GYt}̈X*6eDLRq(zD=iTl^|P*eU.t"F,Tlʁ%bd*tFdx(9ۏ Ie1K{*2ct~H(G"GY,Fo$:&HҪśB2"j7w u<?2皼)-\|}PZyQ,SPZ?c젥)t.Z J7%zT\,%]PڴMS]#cD)Fw,((+LPN\u;S2`)ۮW=*l)TW?KPQ.VܤF巂RQ)'JJ6ʅJFX;S*ho? a ׾=)(k*(U.']Q-%7X J1ʅGjƉtrb -L :M1dA9rq{'bd m5gxHPQ. <(U.0(yba! J5 (KbJM7b%e`ϔOQru(ۓrbmJ5ʥ 2v[b,)rheP\,1QP.\}μ>ʌZ)0*(Q.j#((k{OPn\rIqAh/fc#((]Ar1SRA}~S=TAFd J5Ŋi(kEk>Iv}˟yn8*oyZmgA/ K<~Q̆P^ |:y. 3yrrq$.zB԰/j__}%?WoƬ=q<{_1;g8xi.ճ7F.)rgP~qVҶLG_q! 4KsrWᘃ(:p./f ΁sD7Bs8k̹`|rƗTD3`n$sй=-&ũ~q9&A/ ̔Q_`N娯0=385评0'Cr;s/i9+51B}$9f1G}gip._`/~0msF W̘95mڜxm8*Tv5Z~s9^#N_d戓'ymn&s6g|9^3788_xd{hqڜ68m^bUa}Hǹ1}_d7Ԍl9{uqڜW8mzPs$99z8m֪6o2isEc5U:Q6y?'S*t8eyb~y^?djC5>,+4:r1 endstream endobj 180 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 187 0 obj << /Length 3319 /Filter /FlateDecode >> stream xk۸ !"MܣhyEqZՕ%$o;Jl7npYp8 x]GW/KEdEP>.Og|qM2 [< e`ۙv *Z'4D=§*j/2x]mMaHS+߁rc(G~E_53#}gEBmT_͌ 7+G{{H0A a(b^("1b7A Lp}tΛ8,LQA>c F+R$R8=0ecV0$K.Iwp^7fjbkyh8v_R"hmm-wl**=3JŠDO(3 K_=>^Oz pGJ/pd78Uzx&ݝ&zw}LDuL$TD.%CbMhBF z4'рyy%"09<,Z嶼(ZY'S] CN h#8h1Gp> Gݶ9j]@C NN7 9wYYpŐph*?ۆ'f6pl2˻)uE}"n&ˀoA+YYFQԡ蕦XI1 U.D<:Bmǿ Ow*-A-"F,Vk;`nAͫFB]ܯuy+HDp/Ip>ThYh_4ƉcɷxYЏ(1fy.54W婹H8iF8HE|G8dW#~6kox/܁0F:R"`}(_&cM>h ˑ>}8)'P[2Mpw'f\H>`SFd.gKNRamy$@t2 da<?֚: ]Cqnst!]a)[006;b+ɫ+( UanzE ]*Gۅn`TE& 4[U¼t\'\ !ڠ7wcKVS \qg6cί5/UQ9HMCu-QZ)lq 6x@ZRЁ9Z$I͸jZ>]﹕;\FFm=56`x# ϿZܾˇij(&H;Opoh<s얎?hNv.U#{Rz}N}y!n:U_Ró+YUǹ0XK>fIJhoSɿ^ܥ}Y帔壙 <:}[KGA$n0MH5'8YT〛w7"CR}R/YQnzQLJ8P*Ͽ=d1\z.qFiR %ѥ>z1~Lf3J$%pXo L=*gM+1Q7&\`0[ٗﱘ "F{>y8?(!K-=x(rK>fǹfh/Tm'NcY80z ԿpFQT+`.T#MtvMWuc4ct6S\3Bhgu0ki07uίIes^Yuv e_a^VeM[n5.O0{=cI;IN7bhV;7Ƶ0QJ&_;H놁}xfC;<"ׇܴWPb4,Y;y`>p#0%'4+:5L맱 >-jZ:w6 ۬%(cMAJ{~wHaaXޠcє+mqK;]]ٌ*zY;>s!~L:"9ځJp'h&Pk>s4 G܉oMXb)a ғO!M9ox? gM%N^Ca¡vh!3Rc+PZkFGtsA}f[gU j?~~ e6{zFFj 2qlMA KIդx'p{6d endstream endobj 202 0 obj << /Length 2077 /Filter /FlateDecode >> stream xZmo_!}8 ]1$ERҶw^l ;\vG!)Gvl⫍t 9"9/!EI&d.qŠXĨ HYs Tҵݫ_ ~_GIhQ'cY\E2̋IXdMx$2A[YU|]dq]yT@XD%$"G?+m/KZ'ۋׁ/>,srmtvYszxtgbҟ: eN)7,\å>JƶKx۹/̺zݴ-):ͺ7m/ CШm3j6 dƚc֗/+c!;N=FJȳzV<^L[/7ѾWMUk[ mhnta(&,}5K[U{HPxi^Y^gFUzpfpm D#9X8#( q2XYYr6FW.|8elďo[ARfaRtO^율vUB%.^nG.%=EO{ϲHKkx-r 8_%^ h\Eaazb54N@LGvK6XBGDS1-W߯q;YywsR5\ql0_<LzEƈwnH3E V_/w^i:CGMk#KI7]ZlIXm_ ƄOM8`c?t'dnٯ&M<*7uTn>ܶQȹIKEFs粗"q)HJDLu2SqIZs(#b Y/ 0ygxIpd5=t:&"f6.O:\%@K<%q,3kn|rK4Ȣ _Y $=D@K.#QM"tw@[=7C7T$G/Epǹ F\-Fʈd >)rO"vǟR`7?J-YLHy} =t@A}FD@`B4"u"1+2E(bX _pԚFWm|;^w}΀3݆ ײ$3Y? C]3 jF 禒Lh7\;yeL$SS?9{h<6tUH5юZ\\ o> /ExtGState << >>/ColorSpace << /sRGB 209 0 R >>>> /Length 11040 /Filter /FlateDecode >> stream xM䶕&OnGDX^c9VfzxO*\ Q0A! toWs>jov()Wo_?^#W{.~|??5<#su ]=OOǨOc/dL.py'[~c POOCފ}IXK9S[1tIiZc=Gcfy+w=Ͽ21st?c y+F8ǜSc=G0ŘBˍ~?]c!CjBJ-g1N15ºJ5>9xSz.Y@z;o x[K'\_?{.\_,Ja*B}qáVԐԐԐ\2(01!3!3!3EPCfPCfPCl(pPEePʠA-*dn@p↉A A A AlʰDLPĠ̠̠̠B A A {jjj&AM.L2g GX&u ]&Pw@ Aeu ]A}&ZT jQԢڠjԐԐԐ\ԽDLPĠ̠̠̠B A A oyǠA-*ZT6c&5d5d5d52u/01!3!3!3EPCfPCfPCA]ߍjQԢ2EePjZ r) T1ٻ!Î# hJ37`vroS `;o fΗ0fC1x7~EҀֆh$#qb[a0F_+ s9tR^3c~ޝ3. Xo *KUǬUkEY?=b۷B[n.u^:R7go;n;bg[C9wĞ.~o.B=X UqGXGUWMVķ[%ղֺ!G L,XmKކ_KZ%aM`C:%a}OK 4 /_ /҆7LioY҆7Lië@ׇ,i+#S{$3։awrK}򰴝Ε?ǖ66'8kl*1/뵤ؐxӔ64 +LiÂKڰʔ62в kjX҆E3,mghuHZa״Ԏ1zliSz g-#/b %m} ےǴ!m}Ҕ6Dg/-i|)mP2OBY҆iS0/`J[K z!qI :XR.ٵ_َf9VKR%W!Y1Y| r}w /6ÛfiD\#ZsoJ_x,X%[g }\R{LΩb[-I)5&KWKpe_-N?BMbJv ؎ǶZN\R/XK=DrCͯK]ZJOK)(tznjJDb{>~JDvodپqHKW,Ab'+%+h5@3akXszVSwhH\-Q+Jr y.1-meh|\-R]HOgi+hNsd\G釥M^-#`S>jVKT%Nԙii+T%+5VWwjXh VKVŷ"6}_l^ǥ mvjIw%*[uZƥ([.MF .ZZuQoZuԓ ŒrRh\ߏRA---V-TJ^zr*p??,S"wJƥ,R,jJ8.Zh\ʐ/.vVW5TRWKRwR]<,mey&ߔrqD6.,V.rᧄݾnYŒriIqƲn"K#,mebi}؎ai+c Z~ݒ3JXR.Gޓ ~_-A);`p%+r>Rl K[YW)rBKai+k"`VKR?ZBXaymǮeoՅSK[Y,N)ű[؎r٥l^Ji&VMSr٥1j㗶2KiYZX.D`vCZ r`VKEe}4%>FF6ha) V.DX-בtRj:2nqjY.?J6 ">86yifުZת&R $1;)kޡmvigt~=wkҾ[MԗZ`$C s9^Nګ>0r.`8ߗP~vs|~v2JGa-dnXr_֞,n> J?>?mvY_rȮQyyx91-{!jVا}F琷bT~ÿ#>s;19}-W\z13WB~c=o=1V מ+cc=G})V +cc=Gjpc)n\B9>1{?ý? 1G!%cL!}琒ҳ 1g絬HGj 2$mtCu zTWcz 훲ddex!!/c,Z+7Ő5Vs yc~ c .S3Fɱ#O1$䑎1LNs%F}u Ha$#cHȫ9J92r- 2Ɯm^%B^XJ2WMQc9Ő9z\˿yc1?ԏs$h==+;G}]ϡ~#ʇ.P7e8r9Os]5kQe稟dQE#;Gݢr-W9ΣὤR0+ Q?Nrd͢ITt9韠\e6;Iq$ZS$L.g'9d$'Wjcsjz &9mm⒐mf͏S!\^X'Ū^ NU5s_yKQM}uoqU~卡nuӼ [7l8᯼WM^żM x{{4vlJQ?%^l&oZKO_YS[@\7u{ZڷMV]7w)wԍ՚9j@uKC/E뱡z;7K+k;XwFl7RK'vH Sc7xL&o0 oOߔ2<|ǔo7yC曶s|î^7l.v[FmG|6o-Ur<|ǔo K{6v9/X<|ǔoSYi o|{nli| -'FM޸{,&޺ru|Ku)v~z4oCVr<Ӵ Жo Sc7Yd7x踥Q[i--1<|.`=-{Sc7xL7Ya7xh΅ؿ0[c7xLo}B]WU?|tч> ~{l-Iu3'mRSrz/9iM_>~5=!{~"' ~4INg}rݿ~_?%i#=ݜc]e/ '&ntTIUSQwa_:r\[E۞&p J >,k$qZNeWh?_݇wh[բ>[=*NjK7IurT,QZ,R.bq¾Zrm3t9*KnrX||jibQ8eWVQD\hr,R.,WKg[R. QD\bj{_cK,R.rlKV],bJVQq[m6!GkrT,Q+M:+aJVQbi9^-b .GŒr%9^,G5jNH)VQQD\r*ZE!Nj6e ` MQd\|(xbi+|B%*[E!smrm/PW]-b ^Qd\d[KyEơZV.$`IJ[E!Gr*@ÒkWK(XkKVŵBKKVQQx\̈́KRSbi#-rrʥ-G4%k岵Դj))1&nX* 9^,{{bQ *]rT,A)mkd\y9^,mE,^+VQQ$~m"@[-{(xbe`qJ-Gr[E!GŒJi* 9** 9*/b uԫUr==ynJQ}[tV_T(6Nbkk*{*Bz`R!'m{ 1ӏ>OKzv޿ܥIbT͓6ša2Te!>ƆeQC&Js;XȰ;5uMV>ڐ:`uϋCI:]9`qh2 P6\)3XІeAjxq#2ߐK*eL4;JmH:dCjv~I)e!y؜ձ`iV$`P0Z2`q<~IM4;1Jf~ztuXfV٧š ;}8JcHS 'V3ȇG[+Cq,mW&'v8^K/Zš-SLN땙>š joB=H#s;DQd=V(,H@Q[theA~nSP'Bᴹ,mu F'-Ah 82} =k?3|n=Kš--i?ڲD )q,?8(5(KUomOCloQșS㥲?gQGa4H79G~ILk7@~ YnL]H7%vM;K %2sx K운{`rOv-'#{n"=n oí{Y9`W~vl/W^þcw鐶s|ۧ}_3.:a>|˃ۇoKMp݇G?~zsN% endstream endobj 211 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 215 0 obj << /Length 2112 /Filter /FlateDecode >> stream xZop?,wò-Ek#StEn~^(RbXdby%GI* ^7{wYQNEZ`k'qLE1cIh,73<ʂDD2Mmfa>n( ji  ! Vt]/e'q<D~E-ZŠLqv5EeV#|2_.—]}͋ho1.biġëu1_qB#H~RaW(aJF@*̄Wqp_ʂ{u$ *D;S~' *-Qeʢ#gl ym6uXvSw[c8;ρ[Ҳ< sq}'&Do1>}}3y$;;*.{ i $ %t$$-SǶI4F2ğ7fdUEqaZ$]^owuR(gOU4YPo)  k.,Sd-?]>OE {CͩYʬ d4"S]ÈIGBL.2KtcO_sͼ$m|g^w9 8ޓHŎ;}u0O endstream endobj 212 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/home/renaud/Documents/projects/NMF/pkg/vignettes/figure/heatmaps-consensusmap_estimate.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 218 0 R /BBox [0 0 1008 504] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 219 0 R/F3 220 0 R>> /ExtGState << >>/ColorSpace << /sRGB 221 0 R >>>> /Length 18322 /Filter /FlateDecode >> stream xˎjv5*~xҀm3 x, -X݂u7X䟬6#O'Z}_w?~oh۵j;.o?Mw0-O|럿}{|/B֎,*m^6,mC>'vXomNhs=+miWe:[{TZb ]%0ۗs pomKr)a.]R Q "wDn1c)RAt\ "Dn4i)RA^ Q "wDn7ߺ{ rA~K-D7o rH7o rH-D7o :~Anfjax}lv֕3?S;̏ nە~}a/e^5m=w/n[)ί#0_믏'/8\~}=}1?˼anxˮe͢sn+-ڴwl/L;tH-]src˚Y)ݲK4"ׅw4}/^ߡzڿC]۲N-rz2Mn+;ʍtz#;K^-ڶ#yQmg?w]+1lfۣl 71M'ޜ8sqãQ`@8g0 `@3g0 `+߲~ q`@8>_g0 `@pC3g0 `s 35غm%2S-dXX0lȚ 5k6ܕbƚ 5Vfcƚ Wx`puӚ 5k6\fcƚ WCXfYrk60l`3[2^$>ӳ}zaOn;ˣmϿ~ h[n_\N!cO|d[mV,LQ6Pӧ_ɗomÿ?Pzp/|^PjQL1MD·_:lq?_o̱}]9G~⪵0Á_'H;| ֗MO^+ҷ?eL A YuedngLW~ ˺\,e\1R| 2/V> _iHOҷU\-.?EA+"%eb '&h.@˼/xEfbyx,s Odwr+ғ2O#XFd"e 1J?+0gY ۚ,y2vr]8Y.'DIِ˶rCF\}iB˰.Jʪ㒗EzrtVnHOk}wtl+7db˥< ꂬlĺeߖM,O$RNm册d,d}wtl+>DB+ғbe['9"`˶oVg 1}S>^}Yd_"srۉ,l_^k[bmn)"[.HӾLdt>xVnJKNe[o>bnnrdl+>dtb`˶rC\q=q|@,n+ dt>Ҵ7^2_/ʸ'g~O4^P5^E7d$˥WqxVnBKo{gm?JpVn@VJml}Ჭܐ,66F.>Ėe_mtml&=aHKxpVn–KZ=Ჭr'6e[!1 <6d&˥Ycm\0\>ݐbߖ mt͞i߃. ri"` Y.Mk.~gHr(!12ɇ˶rCؙ&NCjˡg}npVl4 ,pAF\%HwE~-cM'o`qGU}5呒ݏ^6LClo/@X9e*g)1;1ж+R8N~P>qa~F=l;&xv|{Lk˩}@r9ř~Gr i_A/' Ї;ex r; \[|;&:qz=x[yo{˙a}]@x98TvTCU*^U!xExPGC'#U(njVUO75+`,Q]M%ˡ鶒b0v馾PEtSU6,O7-馾e盢T ]b0C.Nb0X.#\ U8Ubš*C.*\ UQ,MLPSUz<ӟOyvPO(oӣr0oCN{vP oCu^$>l2 oCN{;To Fy.e0PSކM} FcgSX# Ux;Umۡ*oCކ* ,75roʽ}P-o'x;Tz;U8Nv2۩ro*vPSN{;UrS6TTC 6m۩roC 6` oʽ Ux;TmPZ֛T oʽm0oCN{m0X# Ux;Umۡ*oCކ* v,8mPS6` oʽ 6`,oކ**6TP oCކ 3{^9ϸv~/@Tʳ@Te=.K#JVCO<4'=F e:+W"a/@kvqV=^@ü'ʚa^@xhXK3m@?5fǙMF߽H4h@:T=.6Izѓl l `n}7ɾ l S%ٳU5ʛdjuF{T=~JY:*'>ˁe{˧*r[Fʁ\ST@K&+@d{;[n5k60^O{[Dgcƚ Yfc͆Xf>l`X KxÙ-gd@5k60NCЭfxj=S`t׊&c͆r(fml`loX9k60l`pK5k60lŚ 55Í ju/{FQ҇dpٚ qf l8%c͆ =l`XD5k60l8jƚ /ڵ`hwo~S|;( A1%S<~H `vhwP~;ZlSlG2MXY\sh-gG ~  a G@ZZz*կ a+G@: z*կ a+GBX3Q:֯ a+GBX Q:6 a+GBX Q zd?*{ԣT!~(U_a=J2f֣T!~(U_a=J)ңt 3ma=JWXR֣t ma=JWXR֣T!~(JAXR֣T!~(Ƭih3QVz*կ a+G@Z z*կ a+G@: z*կ a+GBX Q:6 a+GBX Q:>Q B{OկWXҁ(U_a=JWXҁL~(Uka=JWXR֣t 3ma=JWXR֣t _a'+5 a+G@rGBX3QVz*կDچ֯ a GBX Q:֯ Y]Q z*կGBXq0QVz a+GBXq0QVz aGBXq0Q:^z* atn`֣t 8(UHR`֣t 8(U+f=J\ aG@xq0Qv(U;sŮ/f=J=oyV!=Jq^0W^EoԟfJ WUUUUUUUȫRJȪRJUJ㼾_*߬RJ*%V)%+ʃ2K-Ki*OT`>U<*+UWCx*I֙ɨgnu[$ß⫱d_|}y0yT`|F<%pgRώ꼷zZc*PEsT"PER9j0VX9c VrFT+ҝR@9H T"PEs+`rA2<PTNrXdx:R鸟gL<3̤38&|꼉-$d$%#D{04IGed2<_|E.7]$AI:TP{(K$AItxITw+Ug$03ny/ݜK#穻vs>^_9K|h[*UrYU8õqҍrNjwK9e[W7[]˶ʾts>Anǖ\9ԯSݜ˶:ts>.L|Ill@j罏V՜9j5ɞݜϫH9?$3٪qsdg7w9=9tvs19ݯtl/nΩ^U1Z8}]^=~F0ΆXfc͆KXf̖;%#;;fl`dyl2lxԚ w5k6<>hFH4k6 44Shԧq}S ܧOS>} )ǧ@OS4| DU^I})w=и{C 74^hԽqp/DS~7Ew {41(i )*Oqֽcj!4ihԽqwohܽШ{C 74^ʽm@{Sen Q-q{:ǽ^BGcñ9c&vM8$ 8(5qTk½f f!:8:hik{CSlN;s7OEh<T&RQ6SGJcOE4;0h?иCM )?@SYFДÂ0TwaASOEh<wT{ D%H"A)AYȳIi* :X<T@awB_?vlqO?~ )RC"wzpՁ$/фtr|:~'Dq'Dn# % 0R׆CPS&OU\Iy X>#|*9TsPϡ }U->9-"|@,>QcyPϡ C>*|*9TvaY?D~z~3]ށS:F r>. <)!(w-B]F%C*M!UTTy~Z۽OܘFAh7'bChGT~ns4q.vQ%ֆYCdQAuFVH Tn1<)PURnIXlQasY Q'Dɠ@I*U$%U*)ej@=E&q'Q;bQd"DOv }20d"L@*2UdD<Pe&s;փH"^C!:WXpɁx 0~T,0")PER@II'b7헧{j@TRh8I D-a jBx:%Dk O"?!=ERR[-Ts E0"͗2*T A]wj=SF%"2 9$LN&OȄ( Q<#Dy⁘T1P#1PL$d"TL4L|;o)ohlzܯ֮|\׭y|ܬtH>͜󺼶y'Fݵϻڶ-/Ton>r>'5 }leu+NPވZ,/Uj u,ʪ61vn[锖/Y:4G5&Dl{^WyS/}PyS ?7Ew9Ŷ{ʻ"~!-_xsS/yL%H*ޣ|nsw$;/g{t|3؛``fy17TcYMNj;f֣c3|RڈTkJ7 -aEi'fXO+`J#XkHA~XkG;Vĺ`ap-9_^`eJXDӎֈvF+Qbmh*:Dv&` b=hʓX `IPXm;|4Z`IX];ɍagX$xv&Namg*X$tJǮ+|]{`HX1k8;vie+8;u.'ZXY--Ebf'zXIJ$mvU5Cbf'ءqDېXIjv > V:͎CrQI"$hv+auf'JXI$Vfvu+aUf' 詡M'Uޡzb L@D ξE/DՖfxU/T/MaI?U`,QYwGmSs쑌M]Qx0s@D~BtM*kȁh%HF%Q * *P$~,?!D Q$%DQ DbQ~ccf@Cqcs`1 9KƹH Tb?+U'`Ll>"y&BQd"DE& :D "!zcedL2FdTTLeztD <!:xV vJD HH ν(@DBJPTUp?TT7TsO(|x9)DY%"2q3;ƹƘHJ<)PER@I**O Tlg Q$""he" v Dwq2@D&BT羠-T;U# "PE&L3Kږhƀh%%l$c D&J ۩ JJ ")!@Ij%%')`DR@I**O ToXQl= }@> @Qzxs@CXG`ľSN&XWN@,5?TAgd86t$btq<YSQmi؊'uN-'k@x ZYK9NIgPiRJ'UTyRf"Ull iKD77q\MLIJ VRI Q$%UTS*Up?TT:fc?9 r?(b?y¬ 'XDd"D "PE&R噀*2UdTTy&ZW'XD V&2D V&QeTTy&L@*2Ud"U /g[Ubq_wm>^5o}>{qmZ xKׯcyA; qC>{){Wv~{Qn=yJ^}\6 k/bkٳ*Kam ߨֵ5FƱs{\R8cߕ7<ǡ/$hq ȳqȳqg_Gf7g>9gb7g۟7?<%yT=/ZWKs?lU1Ѫq]k{=L{^1ٳUf!_eNdy^2NOŚ c?ߞSwp{c͆Xl9y;`2lxlۚ :Y8JPS$,d1Fg|LVw&c͆ɬ؍盆qQ^)iJX1k6Z.@ə5nGf-l`Qgk1K 몼-өK+8n*lN9k6 rvV)cvᣝ쮾z=  g' %1G;1 xOam~zU%]|;3~tUz)jDv$X%Y-jDJqRʱ|u:)U#NjDVHˁk:V(g5xU'4ۍ`F 0VQ(j5J$d5J$d5J$d5J$d5J$Fq;rxQ웍lnDo6J$+%ҹD+%2*%rH"M.EzCD~D~D~;D~Z5f43ⶳT-l=< q-U5ɨcغ`d׽Lے! C>Q*`CQ8:D!rG>Q:8e X6X>㔋&M'c?~c C)G┙Q*Y Q"wN~@dَ!8#Up?TT:/N7UL H8QB"|%$3/s8':'U*ۦB>*|#ܟQΛt3yy7Y@ D枬-8qONx Z?y !*C>*|*9T d1͇W*2*_V0mkܧe<<~v⃹Xem sT*yh/0汻̖;%q/^fClxU iHb|$yy|2lxњ )/9#qX30Bga?W] 5c͆xH[|oQCѼ>$a͆#pùS0luݚ ;/O)[m2~vrS5[̖9dBMΚ 9eXnWf- NYA2NI6ֽSx]f]UEڌO2li͆ K2 :[oe͆2c}oT`͆ӯr[}bn^Nʒu>Zn *y)>ZS<.y)>ZS<.y)>ZS<.y)>ZS<.y)>ZS~lSD'ۇ_֓jh>Y^z>ZΚR5Qa<`9߃ y gÏ׽:њp> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 228 0 obj << /Length 1636 /Filter /FlateDecode >> stream xXo8 _a=jU$C֦욶K҇a 7Q;uNv)>^b)"$G>kcxl9|WoƝ(;[`3:\y> \4~{pg~$ 6;wTd '·Oؙ[X(u0Du[Vry6-rM|/k˜93&%ܚ$b δb'gqQ>>q A&l|?U+Xʨte٪s%h>6Pw+N* |m$X.[noS$_VciVĝ8['„8JN}*Q(CXʹEl܂ Xn[$l)]6 ym 'G.r!ֈmkt8tAhV[wp_8z75W«kC|PS{OHPsM@{RI,wR_[P,NաWѐE$uFwR۫9=J.P#좌ļJM+ᖙ!AQ`TxǀA87, J}`*(M3@ `i-jMۡlZ8m*өZd /օUW5&ꂲlu=|UME Rh#ˠ61R!?]Y_t !"@"i8$#:(p; ^&8ᶚh0lH ?05s'å0lYTӥ^0inngzhV3IҺV<Ӆ0t4flFq_>;?\8e AEy3@V،d˶ #.%45;2*&g)O2l- q.*I.? .Fh^MĚm v>F(ѹmF0v~z$[ȁ!Tl|4AiUҩ̀7U_!*ɖ ;<۫(DUQk*p< jmS!HaWɯivz@,]=eG}tv7,x%ukR0k^_ē+݀s,1X,GXʆAo?z}4=aaCظ?xFPw)bN7mYw`|' .{3)F4xcяO)v'\v/{ ]-3lvWSظwֻ.k8NT((jϸR2;@OGq(]@!0ax&*з ^LP };F%,.gyayvFVӚ(ITbȺ׮W0@"wGC$Z` /G endstream endobj 224 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/home/renaud/Documents/projects/NMF/pkg/vignettes/figure/heatmaps-consensusmap_methods.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 231 0 R /BBox [0 0 720 504] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 232 0 R/F3 233 0 R>> /ExtGState << >>/ColorSpace << /sRGB 234 0 R >>>> /Length 9381 /Filter /FlateDecode >> stream xMJVEW&#HH 5zch=y-;b;zз*2pF>}O?o>~ᕶ1r:w4#/Ǐ^w5Jl^Z5̂*`bkU46ͯ1 6ה[kQl^z#˲oa'*۵uuBmy].Kk[(>[_ ]\/ԯ`0@ w [5r#Y]kPmF|k,7@ A }3H}ro7orroЙ<o7Էo7@ }r#Y}kP}F|Rg>gk3k33ԙO9[̧-uS@qޖ:)`-uS@q:)8{K0*@ Xwf"XkT-Ӂu:PP*Cz5*6 ACZ;* A!-6 Aؙx AF*AAА AAP hApA*AAPn>LPa&0(7Qe&0T ̤2LPa&0T *f;*lT9*ߺ}S)AAFAP hApAAP pT8h;*lT9*{kzO*}<6}@6rp}D6$}H6%}L6*{+zkz_`g. rU A!- AAPQ pQ pT8rpKT8*4lT9* wT8* AFFAP h 9{ ssQ`}.6*̽Fبp0>jckk+y<\p/לѴy[tF6Mo瀳7:OO2?xhqoam[6y{-E.ǒmۺJ{8iv -~mEާ&[ۉ<]6vX'5~X/2ԋnU;ىCzYont{M˱-k/=w;e/Z}lzixBh=_/A]9>1%ԙں8a3j'[#:w&^6ͯa?3>meyk6[0ܧ:kMLFx&&(˺'fMK%HQᖹȰ poUd`DHd` '20D"C$20ܭ2,7%" 5߂+iȲfD"C$20\"!  ̮(2#2Jؐ pRhlȄƆۼ 淹 WmS=pe3-[&46dBc !2m練 pƆLhlȄƆoBcC&46d"coD"cLذR2![淪 -SB>}G&Ho?G-a˱\nE$-=~ elQqQC1eQ~^ lq+OΏ-8z7C(鵦EvW1E_ܬy|MmO??kٷk_2Ʊc "6I]yzFJ"\V"V>#댟Dgd,$R[c<ȼ|؛n3N^[d<ן#)dc-C,dc«ho[g#^I~_[ 32RAwvY6{Gt|+9s`32,cZe|F]y{ն[d~ d,xgd$/@r\9Vlf#2Ҵ327^ײi27y?7Uꎶ322c#NͷGd#enoo7&o*>;XAib.p(dpQ}zcB?˴<##nRgdfee'sv1t|9L}<"Z y{FV]zH~W"e=xnHdL$3ldLmK}LDNGᢞΏO{2VUM,D.T>e;>}- o̶K{[cpl9v|FV]zw-tl\q;ǘse:v'ssz̕ЂDa%cL*s.z;==2풧dl\Fc|FV]r=G\q9H=\1W¶K[hz̕{d!z^NcuOT1WlT⹾oӐlf)ۧ䠔ڔWcLGKjQ:1WBKj3K=\G"jD=-C˺9@y̕{ddۥZly̕{dfۥ.6e4ȟ;-2+PȰ,H!eh:\G"P\s}-sy̕{d$eh;W=-r)u(yxF6"Pl1W\ ma}FP{;/raX1ӆ>RE3ynَtnGX]D/pZi?7,oSi:>ĭ4TN l ZjٵtIϱi7t 4ׄإ4,oIl-j'kng[k'F XHn;(r;u6wAHly^.cדvujCEu-N/Ǘ[^-ٍ8`x_mRxkQ_~yJLu>,>,>@}XF}XF}XF}X'w\w\w\w\=2>,>@}XF}XF}XF#O&?L9L r^Q+41*4\z&FKD8N r^ rpu.v:DZr^ʼnQ+91*4\{='FkD8 P r^ rp_i<:sQy2tⓊ֓3U'Cg.6O\lTu hA˨R3T TV ب*AsqiL9*P AAAP p4 2APQ prT8* 9{(FWrR`գ^AQQ`u^Kp0S rs)T9{])F9ޖRƩtwAPQ`AP pT8h;*DF8*46 AC^Q`镨;Xz5*FWbT8h;Xz)Fכ",:ANU^{Q`/{vQ{vISٱ{ p3jeS9'N' #sf1d=}֨(x=}TY<>kTX<>[7o _AFJ_7zQR _r_AWo!+(TڨT *|7ǃ _AF|E&+2WPQ+4+2!_ _r_A*_AWPk{1*|zm/'nnfW׭c4knW׭ |z0F[fs獊^gPQl7;72_-#AEQ^ *A#Z&eDu4(&TD7AES4sqsqO*{r ]\\k=CWkTjTԚ *{O53r)V sogV j@ϽU[50*,fՀX&dqުQaqު3ʧrTX *,6-nTZL8dt+##, Al2! rAō*AŠbАSQ AFō,F&d12bPaQn14d12! rAō*AŠbАs7Ǩx朔[`woJW_M)zޔ4i.]>lY/WS]g;vh:zƯM/Qޚ*1_<=秣HtY%]E#P4[Y1cb٫E2[y"9gק+ʀ<ڀ/ֱ9WZDz: we:6h* WP=UE[PT[Ptzvƭđ6˨ yXbүc[}@tlk2J 66%- 4eBck,66dBcC&4oLhl Ddž[BcC&46dBc+~ :/c+ Z5+,ƞnpjhlȨ'Y&46\2!/ Lhl[$£,ebl:/cK VaDQ,#Q`- y|#ӳLhl/46dBcC&49^d~ICcC&46dBc[%A mJ,%A, Q|kI]Q|oIF Q$ȂZd/]d֒ $F%A6/و%AHFJnoI"ޒ[[tF%A$"ޒ3/ E%A$KnoI-- E%Ag_txKnoI"ޒ[[txKΈ$"ޒ3/ E%A$I-- E%A6JnoI-2;KnoI"ޒ[[tF%A$"ޒ3/ E%A$KnoI-- E%Ag_txKnoI"ޒ[[txKΈ$"ޒ3/ E%A$KnoI-- E%A "ޒ[[tF%A$"ޒ3/ E%A$KnoI-- E%Ag_txKnoI%A$"ޒ3/ E%A$KnoI-- E%Ag_txKnoI"Wd_* B^ʁ9M b=A Y(dPOB=A Y(dPOB z,=A d/Y=A'ɞ}__=A??U9{4􆯊VzW(@G#%ѻ*-[Zzցެնgaj5vbއͶD YvƅތUYXM#9۰MX-+Z;U*9FJ0Yת1Uc\,0jVc\Ƹ[ #v!2Hrb1T2eP2we`ԲKeq5-5-k[֘ 0b"22@n [-3H-XV==6-5-k[1n1nYcܲ2t&Jep Re2@n 0bٔ٘8 KzlL%=c6&Ē1X3fcl,ufLX̘Y̘,ufL@qV:3&`IJy3<Z6zl[1n1nYcܲƄere2@nAj`IJ-k[F-[p+1nYcܲƸe`ԲƸeqF,C[fZ-reetC-[s,Y1nYc20jYcܲƸe #!-3H-re22@e[?SieI,mY/ַw/P771n$_[o )We/;J 5Hr{^^@e/(j*+q|)AנR.r}_Xkw Żt E}DLX3W@rX ~b(_F(6(mPKwQRcZD mP۠rE-%eB"#5 wA]]P8@. ww` "]@nCH]dB"#5 wA]]Pnw wrw R@m0nm. wAn!w[$.2!w wA]PQ.pwjNx,u;xn!w[$nw w "1w p(wT * wrwA'8nϝ@u-Eg P]M_"tW!N0w! /: h~ʟY . =#N*-GUWl$k6zKFTu_4(F7(nPMwQF"h@nttji4[LhdFѠhPa40Tm 2zKр n-"F7(n0dtČF&d42hhPa40T *6ʍLg~i=x^[gޥᱱ#F#1q1 Aq9^ mі @|>Pq Q~hhqÍ;kv5w`p "!qS 7ݠ0-3rAѠhPa40(74dtu sgPk]7w: rsg0dtuPs|2[0*ν[8)7::>F0p7x)V\Ac>Tw_4]$3P]AwRz2gw^Aw)JjOWgJ?uǤ\[znQivoTjGuW֤V~{6ܢnqxyp=7Xv?vFy,z<9sFp#Enp`#EnÍ<]41.vO&-" wFƅHd`420x"^pZd`DBD$20 pMd`"20D"}Qcǥj`츤Z =y*X54tP˄ƆlCcõjl1q WQƆkBcC&46\%] pThl6%46dXÅ]ϢƊ *56|Q˄Ɔ+BcF4gshl/46d"co #cp"cLhl'46ƇƆLhlұ~Jǖ{t]ѷ@玅;w$::wl;6C;6{oܱQ,g)عcTs^JoܱQ(+w03Q-Ap\};W[cݶs%e;W۵Ys%M;W[s%=;H+mٹޒKdwΕV\ oΕXb< :W[s%:(r+ֹj+mֱ.ֹ^+ձnչR+ԹJK,F+-Թ>K:+mӹLJxt,tIJxtwΕ\ oΕX";tBJxt,:W۟s%9W۞c]s%9W[cnι+͹KL֜+-͹Kʜ+m̹K˔>%H_Ε\ o[ΕXbuw\ oUΕ6Xbs\ oOΕ\ oK.ɹގ+ȱDr7\ oAΕ\ o=%JxqJxqJx{q,QU{\ o+ΕXbrw\ o%Ε6\ o!%fwΕ\ o%wΕ.,(#Z ٶf&,XHn#ztAJ_'܊d*pp p'/X|_*r8ihWDM=->\Mk|/۟zϲ endstream endobj 236 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 246 0 obj << /Length 1243 /Filter /FlateDecode >> stream xڝVR8Y)UXdfԅyLvp.Ӳ,q3fV[9ݧ[&Qգ}b ]-LHoPN򻥝m-Z7վtts~wwpb0/]VMz9}U͑ [i;'1%YZ \yl̈+e788v:f Pro;٦85Y')T&Y' PzVF5~ІA~1s)"jک$+е\ko[.dw-(Wi޴'K3o>Hۯ6mӨJZ:L= 7z,KPXW F,ϊ!m~rxr~m|a}b0.n.a.sA7RJTqcJ0rZ 'iF.2k?qj(h$(vj CԼG6X|^ӃچgHi22Ls_0  Y9P:%B\֦>%\rtq'7eR5Nz8.t8v8Q a SYqga endstream endobj 164 0 obj << /Type /ObjStm /N 100 /First 886 /Length 3637 /Filter /FlateDecode >> stream x[Ys~ǖU٣$J̬D*v}n$hJ"e^=F 7B 05 ׸F-'x1})1^V51d^)-ȞauJ1%*֊Ũ`:#KaE ͐9_@ F1 plDlz6\ G=Dľ~l"L|8!pt/xXt/``HX@ZL: X'} L7GeWX˱gA? ѽCX]=-`y?_/WQO]tO!u%EXL g !H^gy6toP4|ǧ=P8zE#Sɽ@D5&lz; x{ޞĥAdœQAA,Q=Q\WS'~)ӃOgYPGݫn #b8*JT(l4hqWxkc{2tEovh6٣ٔ$-+}]?14kY!~+~^} StzArlFFK>6FFc_횀ăIja-x \ e8 "p 9J7>6E"z-ײqygCCr(F~+b 5m>2SUTj/u(Sh20X2*[%%CNϡBBzSm!Z2j i2ݯz1ݜ'w)x?ȦTg{hFkg%'*JFZaN%rD_LlIN*_SafItVC_C#H [[`OaHOlZRĻd]&{%Y7lIv{ܘ00>a ?ؙ%ZEo^܎L!Az=eQGxcM^m҆{p^yKcZ+{/4ۺ~z}hɒ&`ev^x**ؤ|zfr~ruLAYӁ|;?? C`@GEXa3KĝjFG$I6<4zqӹōG~h]\N߈2oQ鑸5̺fg5#.6kw^uz:wcjN#"%1VR:~dP? q{]+z-XXZ V"8V߽{'ߌ1L+n;[EL{1]2H}lU! w&Ҫ'?wNbc.nSO;08Vdz/A+VvJD2[Fou6x>%顜x.H3)p$z= DxeĽ "4\ '5ƊSBCyKjGdbL 'C4^Đs [Hk]'bj>LQpm{ N>[Mt>1s2E23;ĀE w{K$ߥ-|N|m0-tt&o1On6jQhSp[ (i'v6_8)!czSۊSEya*|:2sXMmYtۆ(@҃'+}Y+-Rˈ1brM HJW$Bqeˆs] jUTW\[CSWpc ][E@a>2v.Em`^@%p2m|4'%J8uUK:*r"!}~$a؍R_CI6rSfZDҳ7Pw(n 9J9JOY|DѨ.PPRY1m2X=]Ck `vfJ)T8izd-VzV𚨘p`i׬"P%_STWl/8|6/؎l厶M< 'A(#DM&bEis^$gg#S)YC>S- @ &9g*ҦkJ 2k^95iޚR SEC PG#(ŭTii[ļ& Z#k%,69s{];" ݔ#}Yh,sM sqүc/ⶕm.;vS*AnQ4GK׎yd&*A b89@qL5zSQG#/$G\%O)dRJCk# q]N5,S4'UN>D5,',]hhf_RD'^JN/exe|gL"̕VVMYiVP e:ְwc7jI@-=l0e{V!AM-,H£OtyRH2tJ?[# *Jqje 9!ԈUm4p=]өYѨNc cf,]U&I7Zmu O1o|'RM.r) \v%]g,^a9w FCa .mp+V=Zc`xLW+hӿabTC9zg!9:bW8Y*HtjF<hWD噉ZFԻLm)Z疸eyi[aX|"V mg& endstream endobj 275 0 obj << /Length1 1398 /Length2 7685 /Length3 0 /Length 8636 /Filter /FlateDecode >> stream xڍwP-=w|CNp %X!H[~sνUWS5{uFSCb R89x8E2<nn>Nnn^t]0A!" ! 69 q9x<"<"^nn@sT :, ?ldvAV@g:nrzht@ `]D<<<8N0NVA0d MtMkЁ=P9CܜAPcu /_vp+ѿ N.@g/-TP{@g@# t?WGYA.p' #4mw890CAV}{gN6`gk4\n e1&lAp nnnA!]@yۀ}`@wuoyx`+8d vFwG3`O1dagG𥎖ߔ唑x|8^8x_pxx~_&WFeg@/ߛlXYA ߄vw~o>yTC @ Zh>e8Q!ζj#YkVv-?SxLviB`/75gR= (,)l=ǹPO/><"ym3x$@OT ?7xGv+7(QyX@ +i7-W[ [,>s/n7(I,_@/;q7ϥ}kQBo}ǶgG{Fk)(8t}]}4"0为 ak\yt)zt/ ڮPŸ+֋2 *dȵ̜"}De?ę<Edžwh7z{TNFOfDJpGf7YdƧSԊL`7]Sd7EjmVPG} #u OCMB9]y&8R'њKU^o;Ra' qLg\%1E5$eyC:~|_.9؇~;,tax hZj&ko\WIxN`v4 j_\M̟ =C (lj>Cn^>rl rզ S~NG6R T:*d]ʫUߦqjOTOԮ^Qhƈ+KO<߿/31+}Vox-o.i3gfiTaT!=A-Rl-I?Le s|ц%cyCEЍZwHlrȂn9?M s95LOJf" Ww9=ZU6vW g~kfw >Ď&Sr!}+cq+9@,utYJCܤg!L}Ph!tzQڨ2قu|0Kjj$K/3sg:F̻t1k [6.Å'-BMugT`gaU YۛyR͕v2 j Nz[v je@-5>UyO}V<㎨T=Q2,2g?oE__Jct})#cqwC© 4 SUHn[5r濥gWί2Hj4)tZGx7l6_*T8p 0 8Gp$EsFOKGGuCaﭸrvGJبbd9G1ty߲v'B\D¦Gb 1pp! u1,*'VK Gfe[oE2qSAnƵZCz4Lca~^V 4Dc%B^#D^>}V{/c.PBkhʾ0Q%1b;*vGǨrёdh~"^[] _$:==[?V˿;ney$oRqb_˷{ȈɀD9'ZOBLA"u'PO'BA8RӲ(eÞh#FJ,2Ń״$˯{jɹj.Fpd<u7 )ŏ%0sc;aUL |55Z;(ksWQ k@w^Cklm޵+; Nkmn_DW}Lyj6#='bb>bz6bW&BVvF#b=abn4T!VۈlvB4qٺrSesE/Z+?tIƓ\%pڴՊ^?JENqij<3McV= _7\eOݖvōЩym,WN]53g*Kuyx%g;){TH*Sr?3*MD,/?]@,3}YN80JJ9No C^zd{RM_  oa~_gU?r1 OkڈH`߸ś! QXPc?֬#IIƆWAMCTp4´pKf oq̘ac 79ѠڪnCp%cGhOn;ajtJV$kf4&Cτ*]%r4F SrV[byԣJ{X|Ja!E*;h ^'}z`VBȜB]'jfPNA'S8W5cJl6&~U?|L#ui\DmjJT"Pa>m =QCpWE`ִj7()FEЯ-@LAVlh?W'[4tM=-ӶmȆdv窘 WaBaQ@]Fx ę&}EU&rTFxd-^=b~nL^ODi[s$tmG<eZU>a/jZ[>aP"'U jttj:N?R( FD`&ʓzj˕xU8/X%Zu~D#[(44CRFbĴ_,MaXP7?c VLS*M;ީSvul`-U{^xcq $cыrcY;Ql'j61#L)U7fQ Fjܧ_W{(tG ">IjļԸW˶O$.G!`3D8I=)UtIۘΧqoS#T t8mЎT8:0$r'jߜ(X@~ @G i8 )HSKW}DSViV:'u9!SW5l6PSyŸ'):uRPݙ+媹j,K"g׏D3$%*_uqv~}俚nQm6<)b}lͼ+ ܐn컧?Bgwfqg<{J5?D% ,"c )6s)EHl]Ccݸ {8^Ν|Gֈy١ݿdyTS®N/@WkíPDCoQ>P&~ZTMc)ÔBwLBdrI` tlC(:@#iHR<C#?#IrMvD MT3'['իm ~jܨ5｀U2%}Y"[!yQ) f":y>yfT[}ߪK+{BO+1:Y|`ASt(GV(TNʍ{ T֝wG\VUY=x]69FSpB}CuN7LGBk"zPT?7 ğ4ɹ*RCNZ\;+DXrD9UF„+ܧm7VT̳vPw&ustZ@Yc+@nuݮUȖ3O/+سsX&eܥu?b*'hM_LXeÕכ'?PY\fF2 `y; YJ]_cAmC1J7iuzWWri؍b]٢KqpG5i&t;Gm›W:og]F ~Aϫt6BCsvKeĩ0GP9K(~K MLo5&4NWxw,Ư< !&P،x}4-_kEAmHպW(VѶY ҰP:W\w@k!4rH>[Ә}C_㪲#c=RHღs>V#&T~,a*V$o !L۪ K. Xȋ/>N Tc^%H Bi%zM(I~6Wey2Kx*3I!IDh##t̾n ^aR_iu"i=dV\2WDaJaLHܥg%Y43K)t)SKJfۓi5&۠N ذE0/q8% -iSН'`l&Mbغ'pس蝸 }Ґ~,B1sHd`=U1U3_} 9ՍPW0%?}{SWEMZ^il~6쯗_'=B)ԗo-,x*K?0,~ȘʷLwNjO~{%tTaKuD@llR,ҽ*/MQݣ8u 5b{~NpX ŤYӡd{UO7~o&z+9JRL"l,d{ 8_|OkO xrr1pFN.p`DLFSifjQC1 "Z4H(JTLJN2?_Lؽ"KZn@.R,m RO7:+$G cm hÞf3޻)no䓸(R1œgۙ+ض0H-ɧ{Vh M,x[H mM?"#%V[`(*CAK;5ц\Oj,WgA]7\HV8!(1-\SSd?Ms;TdTE-0kȸ:XuDڌ1>hV&=..ֺMLam;:BbCv9rBt;yg>@:`Rm%gWB6 m;S"~6NcѪG+@Aɑ^գ|()ujEwіGkosmZ+E/ѡCE{O:K{𚄘i\Hgg1?[θ*ՍdLK* @gL*SO>r8RD<5fp }FUR|O1)Y@ߧU)iJd>G̥|]P[cN07 ͝\&2~rBXJs'7WR 13t) MbGl /i 7dNxye8Lm (<GYfN>f9ړSWC endstream endobj 277 0 obj << /Length1 2025 /Length2 13893 /Length3 0 /Length 15121 /Filter /FlateDecode >> stream xڍP[ #wwwwwgpww N 8wwWr{^SSCNJ/l`pwgf`ʋh1XX`լ\mÒk]y! 4v~;dl̬ffN&& ybVfy=\#Lܜt/LƮ@ƶUS+PPY:02zxx0۹088[P<\-*@; d`jV.r:z;[+S7{33#;@UZWܿ.t^ߋMM-V@+@c[V&o ! 0Po}.V. .Vidfvv@{Wؿ'f 4?/fnVNn@i|`,v&&&Nn 4d+#o'_ ~>@?+s;,33`a '@LMm}ČZ":_'@ `ffp3JVFi{sD|T?BTjfPpg O13~1X_Ho?տvV^g7׏ِw @8ؚ_DŽ[V.V@3%+WS5Nbׅgfb?3T\>oc7_0vv6eh0vvǐ=m#8?3_'`/ `bELF?( V)}p*q}p*A_iqM?2:~?hd@V_?c>ܜbAh`;Ӈ~(?tC_cg1o(_Zq揭t?\?Z:Qݹz8c6mGMݜ?.nzMaWLyCC;j<5Ө}V~!B%Sdo;?'#oS 5BE')w~Q=].<n$W:}so!urBTG{.0X>t|T! Z>GT@gMJOMz剴p03N$,Gg%y{Rť GubG$Ek٧8^&<؜`E ؉g||zwah9lx[՜nlΒ7fX7L誅,!s%D[{*AeAn9/+,&y}>ƞ`O~ӒtԴf@GIǘ-sx!οi U΂ZOmx#(|;5 \3;zYvR;t ]1+eX}"eQͯz:-b*8Q)ZYSjl\OaqWD38[6YYtEgyi %svfRAo$m &r_I@36NB0ƷL&45d 3{z ETsz GG]( ‚7.}eJ-pq^^K=&;(FnqCJ{# nKrneqs#bSy}J %~-D S4넬REX!އ<`PDK _g1L=1 ܱSq2Qt8V2e2@i_Q$@{+xkGMA1E85 s52UCdb9F%Kم+ۧyxäf.ieSrgw̪^$Pp^P1ʵ#>W"S7R.А_*CTzHShd9^%ϐlr7Ĩ9unʲ6iOaPc0vM4;ld_5tkR4dSj/[O1T?gRpCؘo/א2=bd<388N68l nyPFX+M'1㙱2XJ~}g90`w)>h(S=4uYt'؜P@gDaCQZrs!4[R'7LVONʿڠbT]u˟7Vd=a(Bd*Sg]T63s]rݠNĖt$מI$PLn63G;ޗ⽆ZTC^ OiPTܸ%XfK|[ZlhWZ2q-z+ Zy)ՙ4 x@*568jJL*Pv:e@3d/2?uQ xГв5m ̵Vdi4:#k\?t}3!*(1*HI.p^^&)Xd)p3{7[ &{%Cg;E/=odM0Xrx#oUeN )mCD/U1UŖ$?Є|kҳ"xsO6̻r?{Ѩ>"=DZIjpxbՇ!{(-3)Tqx ^uS7 x5ܔy c.Sv)iv#-AӎPauy!g~k.X"W2yjx8waO䧫w^V&DWtgӓSL_) #@v8F^IBиbQ)$JzpAiS GVI"5Pcʌx^%\O[Oj 5b.2ix퍿B|`^Զ[X5pT+lŽ tYܬ/ E:M]#ʞA\@VL OrRQ5_v gT2+Io&>2*/ZJ[*52_txVinɶ ӑl0|}yHgw?V!:ڱOi?}foً"]@OvE3~gك~/n{ UwF YroĽ%RHgG24<ǝY;ɧk?\u7w >ӽW) zuц|<4/%>&g,^O~L#t/3D 3OƳEW3slLbPu/c`t)x=ķQIG^FG݊M[%{6HRJzezF&dԓ Ÿq|h"?OW9rEU E$h(G%Ni6)g1ؚM) cvUws^of`.czȧy}5XcBY }ɜoBm'> 7Dîo;gL8R\h@ϛ}ǎq9p^I!wH*B>ʢ~fc#+ ?k:rf;b̕ Z{i (/8 5},W&G/G#g3~NX7>u Zl>]Ƃ)jΔqQ$VP·6p"Ah>!ڌ0/%&`H%L*=-=wn-c<~Kp`c2Xf%wH w@6 /ĿoJWM6 bA]$nn).}n=uiudZaiv.鶭ͥJU$ j?U5j#pg<)ag"G/!.R <\fxSO<$c4'7Ui ߵ$DǍEf3X`@Q&{JTD` uUUQqH"@0sus/?7D4KɄ~;pE 5>L٬7ihLna`"Pq~=@' ^X 4WB2ڊ{=u+@dibiv8ϠĊ נ3 #-tWS%G; hqk$e{ 1.ӳm!/B6ˡOtL:7'|0Ee^2CD|{5G`#)9ZIҞ~h"lIYUn7!;̫ǶWg!먈N @I3]4gF^euΰ?꣹m;u{6+(e\PW% _/.r&Cg{je"<^my`vtrl-I=-8_K-\gWE֘fx k 8aR"b1*ע5MK.<,axck\iP(א˺{sOsKc {3$z'B*'߆:_Eڷ(6q-\Ƴg gownR@_в!Uw꒲SrXYIw>V>q3%`7\W v#u=hLw;{qYrVґBwb6wv^{҆+"LB9M1Z_13MIz/f( t(-6YɢzǬΘ_HSdnWQ w0xAdA7ugx AVSr)k" \]Lhi>K BJ4{'P$j9۠ y][İODֵF=mID" ਾ6% hەW_״+/]6' hr;Z RU64*0Tt | `e9;EH~;Kt]F =JLX!dY #n]GL#(8L+<\1;A%. ͼ=S2* T2Oq!s3¨#0EZrwoѨ)Z!QSsH=R#=4 fv&S 1fO' jRJ_|@mZXWSDRr+ Zh!I!\d'-)jz.yNjXUPMQ{<ΎLU[B"z~qJec}lz޳Nr\Aů3:xY6us9%,tꡙzBlg(MY~Ɯ{m]53.e٥YE$$ !J t}ajb@#YuAZ],HL0lƅ3%DZ:=@//H$#w2GkP].Eӈ)jwYFpi C=Xu }p:yq ?S?BU hl<`Oxd3'Zy% W3U (|OR B!WCZ5n j$OU2m?喰Ț|yPιJ˥dF^zu+s&+}0 OYGV[$e훯.ll3&8آj`hBɅ>I^#8$W_~F_LJ.݉l9L)#لɄ҈" <+J|oͨJfYkh:dkbjQ7#^i` o&dK)|2k9O)nC_"D-/#)jb,F9&k[}NęjFC͖;ywV IE=1FgKB|b' Ae{.4A[m%F/ۗd[*oGPB*#4\2#7R-UȢY؉<bTo'~2 8vIy\3NvGB )aA4c"pvRrdWɍ+2ϱޏFK/_ޣ1J'ьbSiKBS>UjێŽ:@R>F+XE'npiQm B]ESg.\9DlΌLai@i_Ẫyxwd83gYSh)BMͽ]^D`+y s "_Hh(:پTHd{:YfCZEӶ̼8*wCi+nv. Y5^υlʈ!R2cUS aD7_ư",n/a}5aDnDMuˌbݷt;$=HR hfy횃sa̎NkR5^7ہ:e J!*HHXb?\lj^qĐ"ʛ;Ql|qD_~+n@ ~}0V)]0BT*m[|[sI7Y7߬<$d&, .@>=d]SY0U;w~Eڳ6S0n\ D24YA6OJ,ωnQn,WU?3[Ik؝qO_Y\(s=Qvz_%Ҫ4xRC&JfUdǩi#4{ɣX.G_]}) S궁mzk 3''eٵxE,. ')2;n!4+#[c63_0~T%]45ۖ~2rOZwmBI_nxZysBB23&"ō= X8]޸-BredP|"3c꛲pQ#` 7=!-)}C,܍LNJꎄtW%Z3cqq֖W$,S.g'e3֛& lTa/L'zǖjuv:&ʻ=ln:夘^9+K]?\văPɺhଋvb~zO=u[mBC9HjFP0m䠰+or=qI#چ;0H[7W#(X1Ȃ?mZ} PP኏LA+ px ÎVz-ȵfoՑBR: #͚C ݗyRs@7j'[,' \ejpJRF[x~+j^{ܻP+ak~L³IH bI7C0_"!fz$^U;CpYy+4c꧕κCL~p mzՐ^ԏ-CȅiУwXBRiLFI9>̠/u?Bu@8R'w ֡!O{HG']w~O\DO OCOUt Wk nt㩾f6f5wX61q#ozȨQJ4Rv#O?_FX/ˇC*|I[ gHD`t+HY#( 2&t@!]] VH{8ݐTL_#݅.lMMvD*z*. m$Mә-9=NSX|uJ>H*¦PȏG+n&qTj†B9:$Hc\rIGaCe^ /soW%4G~tf.DM |B R0l٧һb ӯsh1$9 BVnSH)>}ùݖظ-,dj 3fRj͖ &laJlD+KK`K 8ȑU Z*eiΖ} (C0|ЀL( 5̴J e+rꠠ ʙ^ |R 5 ?)d{:$pB>ZSP~&{RV^Y ;`mbEO0|NSHƵsQєmc0!a#Wk}  1a(QHfSxx 潌>M;~cW3BTD83q qQleQC>% `?~z2:G$64֓dK3Pp&9Kd",B;O_:#y 1^T0]tk|6kI_H/9reHMZp̾s{GhAs;ɗT=Uɱ Q/Vƽ5v+o!KE`E %I)1#,K4N'05Ѐ`yߞ}#hUyعP҅h%B>;z'M2 d/J!ң6y.̈́ZC& K2Un)mxSxIf)+nOqB3_L4̂b8KKck`IM@i:52XmV08 k\lt&a[1z㉀6q7 ~ zHcOU5)$?EY~Lթ×bVZ MdwXQXTޘMv>ELUsѢ`#Ɓ@1,r/ >^1(mqf+tf LZ0 3䧰+djڟJp!i[TK,S8"(l"D'x#u`bUZ7IHLчnFm"i\j#"1~ox_hL$=GO7jL6S`xsH.޷qƱiU~,BomhݍFڠC}}_'éН.}=& Aɩy=-F wO}8{0]ܪ3b#lX Dn[̿\O<}҈Qv]P[/MJ2D jd`JZ bAT o3 'DG.gKt1*ShyL%pɍXK6j}uh$? `T- Ȁ`nPNR\8LfP#1fgH:4 h;Qgxx~dgg2W߄YGxc7c~1iG[6yA.oE6lsbR}Oȇ&ft',"c*#6_r /Cmj.C)7Zdz AxEmI§ 1:ZqsADLW!dn$].Pdc YGn1Su~`QAaT\v1.cʟ~q4T}:"3ô -ڍ > kt`#Ka\?D`Uq[+P6gb!()M{y]!ټ=ֿ D۾Z,V c Bz*eQ-;g.8ɮÄ.RR0 )}N V~(41^'4%9bL'x*p\9W斖EEH(Zo;QASA߻,.qQlwu5Kľ} 㷵^J9YWdi39D؍Cز⦝G[Q1uKgvY D oF=3UPUN\0'OՂ 2gre ݉Oő {C%@eH-='߁_6*ݞ>]2s-@Uy[{~߳jgiT|:& EQ0r&yS(~Lm^Y,g,}oQ: ;AH/LO:(V2)OO)JFɯpw=oE|0;p;40c[1C?RvXBGWpDɂZ8uxS/&fsϜ9J:)ʓ F:^S\3i0\ΎQ gg#"-]w!3p;.tw>vY6j"šCWgG[&MıWlڨɞzqYqAŐ*p!_Ŝ%-yW 2mڝn@"9Y}"}x.čU ֊t$LS^0KfR|ԕdڠS7=<e"8efIlڥ϶pii7^er>U~zޟW~h!:Ӊ_RR!>_u<1 .sxԌ3*f*: W;8maƞƚPsm'D,)۳6Dq'C7>u y d=gqn 66:.͙>q> j pt=ذA״wc#ͪ=!t,J_P`TB2(V& peT1[ 8 m[ 8FStS҈:65!TDz+l?;(~v @)5X9 'jȾJvO$/s F'2_ ф MU6yB1p܄A?;IeQ/vB?t& `nc{ 3Fng*:aka KJCLdjеiqpG?yq&QreHQ{r8,ZGtI+@ZN?f17FTL>&<` %\L! ̰ܚ%LgtQ6],*.h[5[E[<ǷADiazƜTnYsKӺ <9):-ummu%}$us&e;Ε*I @׳p;:|(Ѵ>e==kfDKq1gSfb<(vK~+Y2JyG=v~Mc蚉_XFQjWVR|UO4v: )jIhpZWh/On|"7>pZ"ۭDmd .ߎ9MM63'Z,-E|GLYS5f== ׾j \&SFۄ| Z71eЛ[q+'[=ꬍ=o`neofGfLV@iEHi@333'zZ2a^'[ [@_+s 7 `Gm 4 56{,?><鿍eUUҠ+x 77z{o3?IU2;8Arx+p{,^{P2@{9M?/*so@vV ZȃޖE5(y.o!boaO%)ձЅ5O3 1z(MqIa\h=]̢N!İ{l~ZTcu#%F=LY.- *1'4Xh|g^Gҽ_>:=0Pth[.\3,]^Q8"W/b%G};0}d} a6999t8?:bI f-4¦7`5Pi(7sXS˧\YPKzw1ҲsWZC>8D_"ԠpF|$&kyW,Q "]\Lų5"$ UHKd J="q8Y֒Aja#zf.tľK,{'V6 > Q:j7ySDaL#)+ l6N>!L CTj-*NfQniͥZL4[qFrnBԁפ*'@15QAIm43PլD\kUΠ*ds3uDMƩ/~bvS!bd*e4ph)E4DFCu6ߞdcY&X,x3_ V2>s"v >@F2knjڈM LNͭ8v&8HL/[1Rez $Z:&Ɉz &Ǻ;|ʧ)2@eIw0gv4UmЕ/=w٬ݴ5X("5 }7gMl) {S* 17S@Ɠ01f#^)P`>KH4h: HnX'|>M[b7NFE%6r+~ZM#FnT_?q͢9+;IgigC38,-~fY|Q)=˄euqعrO,Bc˅ĹpZ9E 0{S%KQ^?.y1y "?};!8mH-3;JU\@!= MdvD ri!;; ZRJ)xkIE⃀Ĵd2G~</s9, Xl4+m Z9I"gwmšʇC=]ZNf\%vctݬ( s}g%wѶjq [x4LJCDx6hعo&> J&aqj,I]lDB}2Bdn@z 9ل*/s(Y4dm2k!Of_8oE;qE8e 0[>_yjF70۠Z,>'L^ h"$!Ohżj]2`[ ^A/¯Jx0÷&ޙjxx0ZckM2{ kf{>TA^4] ƣ>e"m+h`=ak_*8ߧP2&tK)DrI"6xX!0֝>Fpa$pHdooWubZ6-b2=1[ɎFGSG-'ۓpX7\|iiV% Pnwbv D-^ vcUl-Gn!,c2pgR1;XQ`<eL܉͆a(ui!6E c4[-a`ߓ4He|(ERQ` %,HQ U7Vwuc`p^יԦ[|a!u2qw5k r_Bу}!B}tH$vA˦elaʑi/;{s|.B'Áܽslte7Ee5`Pj D-Uág No}slO~WAa wU  |_YM]9>6\<.7C]~\Υ:;&4/H`n)bnf:q H2>C"浍-PPm: e.ysǠ@ 1HD'-r;r3w8He*:Y}SNJԒAWF_`5̎ZS]&n4tO\UPE`d8x(=#W8{/MszJCز[/sREfYGJ1~Eׅ۶i2A8"R|?8Mî3PbO%6vdr})҃טr#M덂q4Y(GfLOMC*tp\$a.Gc$`86th,nzA +e$Ӑ?u3?ٹÜD[ g# =xTRYv_Dk}ݎlɸ7،4N}@Ә) uBD׊c~?2gWƯK4"ƦX^ÕcӴbG6|‘3GƝL%e y(yE) 6/yhTah::[1doCs IEVзU{]?BDzn "rf T{1L=LF[M $`BDf?ٞŤ(b$(( UeXs87+.+-XRY ٵV8SS41>M J">Rm^ hFJVRA{\D6׬$ckJkc :%GtRʅ0UXMP=n.Df+#ln%&S*I&9Q猥GSm,89o4˾2 ~~^f61ȃ3ྤ=&/87#[w\BBvzhcH’8{\l{#mN%T,]I4Tơl];4e9d3OB=޼(PekfOuƃ.8M7/4{Ok3~gܗ(tGzaw4Ka6wۂ`[b5@b<wk)3ՌrAeKRARF hܛt/r@`Z@I.dV๮@hh>ɾnR:9;0F)QG7ed+Zn5)C<) nT_4_U ۜDhސFyl=&N!hfW8Gܫ >t,tCOG3[#7~_3cKbk[eܖl_fœ~u^j,0Ѳ#|Z ͌+ƨɯ I|@ Si%j#\XtiLr?6/R [^~y"$d`H;I* 3W)zdh>`V?V?HYZn^BفL* >`|=fBk*\mTHZ5zrSEyuWщ>"ժjӶ|@*yIw수FQ6#:#d}ZѹTXHy)Na[dKl*78?Y df65|d_[e\dJSUw",{l)[gCtG1LǐTsJڰ ڋSP*Jycdէsin˹DGlL:⸔CQ:JZwV::qY`82"4]Y>+MdHǦDZ(lHqT&9It]RqEaL7hkx>8.2 naF]N8t@m ~6 ˧\ CâEgIHN ZO@2u;xfʟ1m-#j@ʥ#UPj|؄Ljt9Lԗ(}I-PNbN c#.^0ߗ%96b"=LܶK6@5*x(Qe_ɀ*t{i_PA67cq>{ ߺ W_ ݂#VrӘG>s<:<7vY}D$p׊yH nnN悯эFH݇JͿ+T}:Q5yBc$xdrj!̖)Ar6aٝU,qUxGOe.V3:G_,w_=0T=lQ%WY%ãWJp ]6ӲJnY(8Ʋ[7Bi:YKzB%㦙_;Qz$!:7I4O4 n&P$Vb; Ulc}a0(@vv"0ɝ6h)֩*Cxx%:\,>51C2`GQ4azp ٕݨYI⌕tۂ3dlVO[yH H(d{n}' `9{6FQ]07Y_;S?]hT 0&G#/˰ˉ9P~>kظ'tTp X'lɛ̨8Ӭ9_1r4i&)՝gqY:;nU >?a^@V&I6Gs#c<!/-?γ~K PU>ysP/@KLi6FA ƈo- kۗ蟐С-N㮑Gԧ5c݌K"f 35YmB+`3-KGh0gPN¼oE EsbCjiFKA" prwhB~k*A!,وo6O +3G qWOOBu0ȓTmzMm;E6#mwbQ[ Ti!1>3..iKʸtk~ +6qƜn? \pAg,CpA>#[>c9_l U,߶Fˁ&[wjol7CFU0y_Trdni)5+rMTB}Džцdd05n3FH$Z&yAX]=l󳆻BK[xp\Qe7R_G8f."$ƁuW^u͌1.fVƭgAyUv!aO*.qTR~ u5s2 BWQ)RΒY22e˙]_uBS@>kD~F+OSjoU+D߉:s`7ښ'Ñ'哢YV2n|һuy' Ԡ/t(A6Ur$$_9~R (<4RXSl8^ؐyzdf>F!  cv[2wϬ[?|P${W㷺q:g\Fux@t|fŮJ[7fQW?E3D.&\jSK۲iY@_Y@>rDSӄu. |Ul0͐Qw$ADy>i`;eM 02#g*w/d Y{C,Sz|#~vꁒaJ\"ԢzZ@10:VрgN"MCTQ^h] FM $8&l')  Ovt𡤓7FpuD Ʊ ,4|>7h%S*x/>J&>Ԗ<\Fo7gs ͉.a|4a$/Sb5p:8呂2 18˱)&P'j8&q\.HL v'Vx%a(3#Ȃ6!xcXsޛV^ߋ #owLRUCQ 缒'{LmZk6pcÃ=;=CCÙ֏qFs-#5 ~U׭a^9Ӂ/đ7V0gwU[] X; 3Y7e @):KiٷT*{ku|41)V5a8H&KnFt]nEA9NjϮ)ȯtv }LU0b嬿-Rש(5W!917kyec0m~XXh4s5ڭr6D~BfA ^CTՕh 5#:akT3(i[N1|lD b>@Y!H_| ~n8]J}H1$kUdZF93ʨrVyJ>&e)IZ9 _Z8OzoJ,Hpg=u{> 'uq;ińV ~0!EA74q ewvTmn3pD=Jb|'ߍ7eyԕ/G_%;+pݝ.ޓԍGOG㨕~9"2v^9ҧ9D]4O{N>Oqn-A.UDTWO $`e'ZwJu~)Yyshk^f-TAoTtRHB3'X"q=2_蘩ko5]&:xT酬؞VUa~t g mSdKHvf{zIٔ^hY%yGBV ~|RPthA]5VEo2z)SY{4>gp?qhrߏJv"zx~>,~PQ$[45qϭ{qg^ƈ $QT5k@qͪzk#Rd/8#.}2h~Lbf l=Q>v)` tveeE;;$[k Tsȩ|S"U+3c-%kEiȇ/q~ B۟ -X\I.yoq8aDWxڢGŋt Z(tYc}Xc%BqxX.$<qM]Q4]P&^r#جĮ`v iQ?6:oKG}\d4g骷鹰HѷG|#;X2fՓ }[IyL0PfnZ nB 1,x-5" YJu%'\DN>gRՄj_K2kdk:?ǹ sK92Ғ9-l. inQ)lbw^j[Ţ.:gv7bema% 7|5QcYZw'}@YU;AtF>.-uQ2qex`#wzX_d`=)Hlt 2OIqGNٜgwݡv9QANg'󧿰ĥҨHd:9?Т6^V)?XEEQFOE@j!SQay z1["S8Ջ(3V±ښFӶ+n@!k/(ȸH2*^;j \RXɟ?"*3De4Dܪn` ˣQ .u)d&^|]r^Zͽ@M9dzStD2wE](NRo(S?VrW|H0W$F}$$KO1o@'Uz zɥ`T3A ~T[_FҦ5@lTq:yD*tN|bεz W;a)-E%Vҍ[ծrpN+ %0e!Rt/J*SN3K y66Azq:1oX2JN@}5hіyKjY88˜T4t@h\{4}{΃-9FVO82'Si۱ńPMœDU2U\<UwwaLq#Y:^{_Tg97Ei7?lAeu>Α4QMp.8.NC~U P+l1wNJd0~Z@q0%?(x]Q^=ءIKCO`&pʵ6ky?P}]][bհ9 |ɤsYxFțJ^VA0bE T^S}U endstream endobj 281 0 obj << /Length1 1523 /Length2 7474 /Length3 0 /Length 8476 /Filter /FlateDecode >> stream xڍuTӶt.H䲻K*!H#-) H H/yw=gf\󛹗YGW (^~>@QKQ_@ <668 G"$AQtQ6%0ꖩD4ܝ~ ~Q  EDJp(@D.ޮp;{A=8 ~qqQyg+F({@ PJ!eBH|`g7> '`0(h66><6=> vn Np v㎀\5\`?Țxvw?%#~!  GlN0#M>F@Nnx% Po%) wA~JsgeT C~էwAn ~HOuw"OaJnMxPaH{yA쁿0vv2ߪuAloᶰ<_7 ruo!( O[3|;p/v_,n D8y&*i۫ xA~(@y_[u?GBu-_*n?mLYs0r^!_.I7OC;Ý;vAko1쏵ւAUGoEaw/n*p/T1I]mz'8tzxAݮv{an{}0v]2ZIaw;Hv*c%*|2Z2껔0 U~[JCY|F>q-LC}㧛/yɏgKb=%T՗ rC|$L8fF!jsi1$@g۹Dep>0iW-pҦ}T8>`ѪwTZVT4.Z;G>!$aq}_lS鳨:s|'˵Gb~5ϟ=: Lϥm̄-*z͘kW `{~ֻV|ba1BÑhh +# OS]T[L;oL}PM`BbESaE?ў>39/0V%[И߁)6yV3g |.枇k 40.ns|>!ȢFY$laB@SŬ>-B+2M] 1De@ sgJuz-A_o9Aa*S#Y-ac'<"xy:*i[\ڑ,O8d7Dd9sۻ aC"Lި?ݻb.e-H|t!=m|m&52 EAND.SU16lpp}sDjEuUU($6ϳ물]/kbF/bMyEpW;Bemߡ;Y<*?,KӃtYS_]MeZX]q G/]Ȭ5YSNk>3l _٬,g.x7G=wX]Jmh_l(utoÌ-ŤYV Ij.GLU3E+'~?yjI12von;dwdd{5j"-J ;\xF%Il(1,H"ZaHc KS`RipS|S\܄) W?nq`ʦW佧 Z Xa3N`Նl)'L= q9l"byZ{-t:>VX~C\딖= si$77ۊflS^XQلP|zPp=r.ˣ{Uqi50WiPӂBf74)'<312Љ`G֭70jN ѦƓJ{ ,rqzʲ.(8/=`|VsmBmxAiye AhHN5[~}_%2T#(A>p=i& lX4Rڱ\tp²ɒ‹Hlyzy\*ß<3 x4H>Z=T*uWǾ G͒Nf Syʽa;WJP|dc^ⶠmpV':fͺ2fQx/x@*K 4I}{е_l5rj+IAw(xqs2ku$r2hoNJ㐆Dq&J Z\AWZo[2+bFpoiSK.vFӭ:.Cyk L Sxdn楌; V#jmt:4/NUƮiƮ3&u*T6yM7?ۣY%l*̻Eei2^xw)biu1k/)iUz$gƸhi{St| Ru,A-{ ҙJu%չh+ , ^[Sdt6uY05p@ieNqT_F_bOL~ u˫2^IX)'F!itlXeL4<֋՟]gJr3Ȝ9-2lpT[bl ;y+T$46 g/oEqIE;o*|EFi&wGu$MnjLږ7 Oۧ"6//Y& 0_.?#9UfvHK 5}IP}Ch9hvi®c5)YZfLc}l϶e$)zPW@Mp:s)Ç̜<>,JJ^w*q:5-z+0ӗWn wsp~D V֤zP&0z@i)O9w:XL4$qCдw%y 8rc'U͓ ,KҰ<ؽ7~y tfZXk4! uAV Ergw-X_ =G%ަN'A8a"sO'O<=?XSCzr!\/T_\Й:G$A$m9\Sp_fx,4#C чPB}o-/Ł X4Ἰߍ_dΧ~zTi m緢u.,>1/=aS^XvtZeTQpAi{j*ksFLP#/^=iJFRam"߉7mn~ժFuⳫ;8G…, v'b!e~z Z&4J:˽:eMG爟0_iPw!g[6Wg8@o?u*=Q'g5vN˽ JVfa41Q94vV Sp& ]%_ο]%C,ܞK=mJ #ܟTNf9:v=Y~(WS%aPӇ$+@^Y20=5ӱꈠIDݯFntѴZq^SD7Mp1 * `cFjZ_ lT.NPX]x.Z:~P@WU33靎 .74\畺pΠv/Q&x<ΐ)#*༴Th6x阠Bxc&0jKZ.2z`[r!_( Kfb1 eBhrBõ HH3X )X<)4!&WKivs2a\+L&y<5YsxcsS9A7]8U!cD !ۜt t~*X=OWM}qc~^mngva^m~y/τ82|axrHUl~..bd٬<7gJտlj4尦ȥмNBJ9p@Hl7X3ѝ*mM/-ڍTd['N( 4}R>l|ȩ|LCOphܦz𐖌It[W(eަ`Nܙ)Pl2[MDw&Kl]mƊ U)xbZK/;2 @>oDms"X-O:ӪJ򾝘?( -朅"6v* e>1 m'= zu`U3 A[};Zx9$Dv<3lɜ4YWi'A}d-~nkx 퇑[z] 4m|6xb : Èrݷr_CNA cnj$^rW b˳hXHVɼzƦ|I8u" ȡI JZ& |- 8!KaMM3jy5.gȾ?w2,TMn[_֔Tk2;At w6GdZ[2nuP\U*G8r(-톣L*lvH ʗ폭 >)sNLĬ9|%Y1$Uw ˉJcR)I}2@k~y@7(qtcė:y8%3VcB@Rs}0  Xy} {v53on{rZfKH Bgb[砚bF' EvgBAwAo,6܇,H|Xiegxjc7e;0j-p)mX@_UMY6z7i ~ Kkbj#a':Mc#U.x@v3d O@d3n{i'R$y89ZkY8} Qrj ]dH7FMcFݔ8g74, 9~SpWt406y^aTokX\n* endstream endobj 283 0 obj << /Length1 1979 /Length2 7340 /Length3 0 /Length 8528 /Filter /FlateDecode >> stream xڍTl6LI .]" ,.,K%%!"!4( )HI4|O9w8gkf^vf]}~y+%T@ Z $, QFPg8!G3ؔ(L@bRR @',P­Z $B̮tp[۠0 p%%~;@0F@0!`{>< ( \np @uvZ~hp f]#a(731!P au`t{:A}g"8a0tp#<k n@`@ s ۃ-1zTt8Q..p$?`欌RD:8@()=ܯ+O"VhG!+1YCQQ$.. :_Nf o/G#!à^.`W(匆z{/"X!(% c˜pLA ~1fɬ{n}_K߈z/LU~!aa$@LR 4򿬺`OC$?<\^ om$f0 g:?-p ;=4#C v_: <" p;JڜnS"]?!|A0ϋ ~m2)B!Q1A 왐(f!0jZqPDa003ϛ*?M!qP7E7,#I/ H{ ,? _(91;;@@?h/ G06ӻ0;adB,0b"IyyPUo_,1cc@_CI;Fk@3|1D,f? f@8~C!i? &ZB_fg~(Pw(xr  jG@)$-o?rj<]Dn16^ᆨh*1jגQTsЙM\3v+_AD6>_A}VV 0oZ1ԹpU&Cc >f%kZsBg'eFwBVg%VO?_/s&Æ;xL^ 4f1H7H~LoI$!-n|5?o:eaCh#\9߷粻X;v̬da{I 7 +}%4#>֒{OKI']m;*"ne$者.Gy]ƣ(A8[qwFm iM'y,ĮhPe+Vz51Kr"@Foft3] ۝\TD5f4e5%M &̐jvIM.[JrȦ]`Ӣ}ypU:2r\eϺy^~ 䘹EW_n5GX0T/s}%:. P.)nX l0Lӷznʡ|HP><#CyBCjv} y"_ƅNU^> w*i2V$ۆQoH};˓<^ _)[qu||K޲?k|]ﳘƢ:xn=q7cܵ 2P}U];1ǝAګK>.n>{Hq>VZ=%<燊XoWmQl4A͚CCb U>푏i'|-CD0`@ mF~rq5=NBEp eWxu47J܊V9p*#[SJ::'"[>CϤ9 c5t]Xtjfb襢Ecv258ܵ"Di 0v.eM3ڭC"Ԛm@-I2Li2q={gl`zδ[ %n{~xNG%|$bL^:g߮s Ċwaǵa K {x."AUdsEy&.P;M@b Ue԰[oUVpMذ8$_B(:A[N{eˋp? >ùw>\M?CV y?eqG-8oCZ*pj]1*O /8\|gh/X)9h^螬\zjz@L->˥P hMAAK[W@]C}@]7JD,gM\;q$5b0& mZu;gn }%P~`6UIu O:O0Z;a>p䉚sƁؙfRYo͘nɧ?6+WsSgFYL31jPN.,[0~]< ]g;T<_V5*M΅BDo}q9nAQ<M-z}L]"FY(e%R[+XUiSN<4W3s{X[eCJuYPmfԍ{AY[ hi*R9$JL?R vd+tJ^it|D\yL^I'w >O'>2Cu_93?_'3[ޫJϷ­5FY2k#bBdx):/(2(sB\iGJ(;)x£tfeX=]g\nN [/pfo)T#T+i&ϘZ, iǻuh}WDU%]ZV˃猾ٗ٧j ? Yҫѿ%rH,,mm Hc}ד.}V}C$A8T!H[TԒxj#Y*nqD@*5ٞv^34JO(+2=v.F&ӆ;To}5˫p>pzbys>d"K몦DRiD}lBO B?N˼wH7Wd<wL@7i5.岑 u2_Q"EsHwР%~(Z+uUȏd# 1tڌ3b#oOçXSSxwi_]^i9er_D#zt* UFƖA(C8WMuu,Ku:R uT>8/ he? NUXlM(&oqF$r)U|;e ZQˑ1%6r0[tFQf}A5`*xVEyb z:gaek9k؀?BDjI dUxTo9zlڂ8-c۹xt^?{35E,{} SǸaܱN,W0,Ƿ=LSPK R Dv%s;[Fofsi}㴅D+=)$ $n"ctaca_r/dfD?'bwO{;Ls[^?}}KL0-4!erdWխ vIf@r^EBn,~Jʏocs>>Zϗ zJx˲}{Wf6&ݝP͸zS` & #ymdMp.MY27Ҍ*n#Ü SWhl8 ,\'gȳo%yi,[?P'dnZX TTj$_Du3 W\9b@o̽2:mdl}O~LPI`?[H=on[s6e4D^]fryDCC%{k( Q<]A|ހ<Z!LVkѪqY*X_L:햢5K$鈠 -^5wZOR@)9.:jDɕUS8 7%Gr. `SZj%D`wʹhuqZ;Aw勁眉1t!̩Lu K;9 }]O,uOov8{v&A3mJiqP)oOQ@.,[&NSa& &g=rRF͸@M48ğQy"f|x쭏"9k}ؗ4wMf[wn v e5d38-+jbί>>,xT>O~i>X ~Zb;ښ4nK0 /_ $ qW:j6SQFQ'NFЉ xp,U'S;kΊEH 9:5>įNeCe;> wur-uw5VeOE&*i%s#Ų*ͩeJլ=q53X pw7?m|}NקB+!=KKZdO2By 5#FfQR. R IQOQشX#t׼  963KY١m :FdfgVV#tһgj\rgǶ~aD]vER0Nz'°Kw NO`{ecZ{mnwHJURIy߱%ǶJ[)aE5q>(ަP0w>mJ`lX/yMͿ~T*֥QH(\zt.,#W6s.rSj1*FViՓD&܇rx"Er}$擨H)⮟P S6m7ƉzeW , Sk7ң(֩y?O)?Z 9cE]WG,6xfJ93 92k$ }ܥ|2aVKpƚGX@Iы呤yC|Y)5F^ և|g!Km׫u¸x#չN-%M7[?T$^]./qAxӕJBz+ۺ> VA-_L¥ZFGYu(X|R!_YUtts)湽,ض#2)`ng6ϯ[q$p:cN\gװ]|LLOeXȏaYQ}S n8YES..K6n]h;H\m#oܬw/%P[L@͆ދz"sNj 1\:B)c怆`VrCJ5ΕssgIbe޽Y5qsKue]hQ|y)6!{Q-s,B]3ic$JVQۘT'X53Sb楴wDǞkߨ2k?0j9AhLm4OAByر% Ѥx>d/M[ʪ_bp>ÛpcȫG =~?vJ!7o۹ ߤdJABUZQ0wptx[N\ƺ&@c%EWޝ~|;qhXR.aSzDf3X.f7lQ9Xnz-~p[ş\rbx6QT{O珔Lk\I2T=4}q6`Ehu֑я endstream endobj 285 0 obj << /Length1 1506 /Length2 7838 /Length3 0 /Length 8847 /Filter /FlateDecode >> stream xڍTk6t)!1R -  004H7*! %ݍҍ"](|9_֬5׽}g>唱YaP$'P |\@ /.GdFB`PCA{<yT_:x<8(h@j\?f EO[ߟ'uܡHo6/PK>*HPXOXv=y~1zap= /| r`_4X#V`;`ۿ# =xߟ=3usj) _FYY+B_'? GF- oް&`˿o Z?o?v鏝/ q/ˡ_h ZU% < "?Ӹ\!/( lgx/~[߯I^AyS^x/ \P>p` C/[$,6$ 6$ ྿A-}j:~@CC{80lmf-P|^!Cι>,qrn9oQX̘UGܡMSH"ZS`'` etʜ;e 45No֓, n7"{I)]ۋ6Uy֥< Ci'-jh9/wSre3>gXGfg0Q]rWOhKQڠk\šQp݊/wnvPj/ϟ J~%٘,᫝n`#ʞKڸF,By>%M`;뇁$ڟD7,7dGNTRM7K`ssgGEy!ΤՂf,AeoV!=Zmfzp BU+58!=Zㄲ䉼O=Ɖ+y^?ljmPl)znt`m tHYe"yn8ŞB.$/1s|vr2:ڄ-XĀ?z$&BDY_ˆ^ty1<*.@6o Bsu1U%,]Ú*~8,C*$CvFӥ iCH?n+5m@Z ἓ\8;=S\MZ1<on$ joؽF`E{=tkO,H\zybT.CSg۶ ?Ԯ_O0:;.0Y;3rv嬓9^Q]< xLI͉x=8m2l;B}|9(SdplfQR*Z^ϰ}eQ0tp.!ND& u9^#0ƬQnP# 2xҷxc,"T]Wg(ѓX<õ!Q˼y9~fcȒd wNi{9g:p;o{R~HH,swŸ`cGh t[6'F] C;>Gfa{,yZ6&Fg7cLTajP6 >Q:Jc 1mPy5k1'R&(MHׄrq<QJ`,lʭ4c+ᲔC[[Uc|q'c֡l?#J%ԳJ&՘eZKA{NcB57hROH|Y2o|zӪ~&U5S|7n9p("H_C)׏ƜԔU^Sb Ppu<5NMVi(ٍ(*;c4/R&- t v䖥a=}Cm2)nz4 iFuQ{,IМ#c]v}k ZB,`W)D+=yTՒQA4X O;zY U0KAenqOZcM~RO!T?^s4u@ k_]flrA ŧ7wLlT_je7gcןG3>nw!C! |Yuדƍ!Hem Tn\u@S?7ܽV*u{Ƨ;ٺ":/tv u=pF/BPA5‡8EgE|>R:$݉F.U_d0g·J%_Y 8VҮdJw\;Zgi/WIGr0(uW\&T5uvUoXDP:+s9b1z;h1^nJ t[nDؐvG&3l䆟`Vn08N9b ɡ#dfF1CDCHr:<ؔVbȨqBtmpQ7E'}/%Cu(1aPI~ySIP Reb檴HzNk>p4[6͘suq޿ZV{y*}rHڞH3`p qgfɣC^A/(, Ћk}ظx;OQ =v"w*gN7`f9-=,[^ cn-4lكҬ QS+),Đ 4LEE{UdYB]V2]+2cp#*"VJT8JHfّP_wMeו&vJ.T)~HS/ҺwqA:*4%\N6g9jDbv2$# |[&*Sm3fWhΓt <&"~wtjwR jT̟؏"8&3pVcw.A5l93½}=lpW|ꋇ NEVPmA1hhV\Hh9iZ_ڦMjzA %”YpV̬1Rkb. ">˟_Xu<ޢu{q3`7+Slg~Fh U-_ ?(uA'l6_}(&n|=rsXR3IXvSHW~ mܗW}Tu L.ɯfZ;!K:~H0}'s飊zwlNIˑ0/%/?t`~3teaKi#.MqSEt3 %M[Ƨ![R#c?-$wS"1#j6y8;tt^y  "̡U'kCҫ5)Q $2*UʱU m*>R=Lx32ݪE˺2NIF͓*h}bG.=|\Kd=Tw)޲9EtG>FӛwZaR!R?1bPbM^{'|kr6,`%X.|삀@>^N.L=8=gi O=ҕ@nL$%^ )PŹ19CރOm\/_W8…]רHFGa?2~G}p[_jumRNJij]矲))pϏ5G+}7cj1 |AU ~)#qcm1u?a,`/+n߼y%Ryt }[,Xg䉟̋I4a4JlRC:oV_omgQh(<6 {j;&긞.8ղ](,TxR۫p xqs;-l?rҰqg`meF}b׼hC'V#H(QD(!LX$ t }ɗRԝ6la^3!F~8^sf6j.t7,+ןԵClj{3uҒ`.Y؇7reIz zL(t؟0u RgBo=.s6At?5M22o&̅=aw.\eQ4mad;}N |'zOԭ(1t&aot[~dw\SWQO(Aә 53UanX;L&ѫY) \0iH ur sހI džW$hJ)Oc[/&Xc|ZbѲ.|Š ~aR䘧>J;xSt:]ڢh+MأY]߆5 ޲GHσhGyTmf XQC Y@D -=Yg*~$8n%NOYz]r W.%C7d/tp3nl^es mvnpf+ ѧ ,*#:}mwR(5CШxE$^Tnil..^3weC,̇\`t(ix"N|Y!Aj!e+Vb%C'GA+$HUVHӄrݶD&$!8)[R*^ʩ/\qe䁅Io/D1ޡ<:g,mCV;| ʖ`x& @o4FB)ʹװ0\]|]~XG "媿mRDehu Ϡ:ƙJO >3Ey&[%O;c 1qG e\O r8}:QbEɘo3ݔ3$5׸" X -Lm- [ eMA)XE#R_| k뵿xI6ڶ^1p%W 1&XdLz `A @Y>4VY"~(3m:$Om!Ih稍ڢ>d7ns4%Хr?clgNabll ث_+{(a~<ވJ^AJRf%9_MFɒGHL|n-??FC?:,Trԍx> stream xڌt] ll6ضn4liƍIcv{o{GY3ߩw-JR%UFa3+#+ @T^†@Ifj G@tvr@h 2nVv++7 |1cw+3<@@)lea G)-/w oj E45:Z]CA#`dllaj P݁f_ gƄ@ Pr[`a V@{ P(:6ۀOmL/gcSS;Gc{/+{ -(!07ehl7v756urc2?鹘:[90XJ fvv@{W_rwgm<}Vf濒0ssdVrrJc!Y],,,ܼij^#b:|T!̬L]&@ +{ 1o j'@4{_>_eVSTW;u""F#' אqKo_R%c@_?+C o,4G_yr7XFH/5_?Qvsh9&UY_1h=-l-'L_@V@%_ ԰- Bq/O )no`k8^փ'f@ϿFd r;8#('h~F\f߈,~#^,%#6o`@~#P<O7S)F*(o`V@٪Fx"^2@M~#PF&Ʀ6@Л_st\'I88~I~|f? ($7PD`eqr-oPmCCN_)X ~s2wps#}:P--Xdgi*㟩jlGjfڃ6=(w߇9;G JDz]HlЩAWU*"wrsp⿤h+fճ?* *AN.@;/u:fퟣ JwXj c"Arp5:ry>w\~nΠfz_ @'aa?kH}0iZF6GdϴUAkηŸQinI}`?|KPnd2ӂ0??HQMhW#C2ɍY)ޣWҳti$lvGyKt1Z=J/h2$.+#'4z+L=q4{:[r56N< <\"I*$9yfl$eFT}*+Hƞvπj~턚FLCg2EH v ~JFu2"T+`I(gp?]X.?">AB V:qK݈%tdRQNM4&*âg'hP G|/,,:<=#91~ 3hs\ &_,ō2hrŻ>R+2W`3xor_ PpHKUEyY?3jT|W&>dݯ 5߼-+1:px8Pخ题*) QxބDMĝԮ1EShgC%u|y!7l_idPf.A 5j\{Mn~ܢ+msFBQm]x1hZU[$I@ö`;|)X+|MȲz$mz[uF ^68Ś`!)O\e2m*,ҹI960ݬ4뭂QZAphp`[?1&]`(璆0ՠQL#ˠT1A/~q-U@13ycVAU$s0ĜgbDžj8okX2"⤑@&1+K/\@ˁY]|jNZA\}}uuw6H+O%DWo]QReXA[aIV|%}7%[s: mCÝT7N[^YmVi$>Q٥̃|6KHn}9i(dbڔ,Ӳ,m䰬qdV1 r,uX"˴Fr%σ&uNܣP>EI;T7r^\UԜ3\ti-tH}Heckئ6-]+Kb{èy%R)6[T*d$q"3"p8f`y+TsxBߥ@q0q7@[19山Pڳ4|⶟+bw*Wϊ 7dW2uԹ @*T*a<ʒ/=};HM3*dX7볭@Nas7amU_I5H&|h+Ԩ#Kݲ %B 4ݣQlonZMOm8[.0@))'Fhp]-NDoZ0dp`)`!<>*h]j84ۆ&/e} 1f5^ڐ_rj ]HYr3$.HؽSLQ&$tWt!_yGIG-}(#yW !Ӡ:dǐ{Zt݄]"=Yڦɴ&5yUk;3puSzfw|Yv~oؔ})$ʈ|7P_jM}O}˰:{_t{ *V~1 gt>B{_C>u4| RI1k݊l8',"u!2GY{\)q14]&S+M?~|x~0Pfũn:i4] lN\b푽`+eyǠ:#F+GKrRHYP%[lryP9R#,;~u6j^{gza Lsqb'3%Plo0o-3-,U#R7dzysŕUح48.G M(|ϙ#eG\7q pQJ1`ԻIpBoBx^dz4ԛ@o>6ULaUĻrCv5L+ U܇-p|R_>Zx,"sHk y_fCV<:'$e<7FH$YY{<-_3 2W =|_$D c\zڽߐ#.ӅgMK=1T-u|-"|U y`As]≥̀Nrg4Aҥ)DW *Ϋ֪/}V8RWEĀHEضȳ0gN;+|QY,FLKJ=_BrIVOĨ4 Kg)`֊PF\T¿Mx!4oU朄jx}l Ԯ*(d,mm`d_mD\=qR,+a еLRׄ.q߶C1. ,4mgXCC}%s4?*mW(kCLϲ`qaoXKN1%6jYY]mDYzNqsNSۑެJ=!UQD2$϶4p߀C;v _ڞUu*hu޽bLu$$LJ`3p3;xUM?ߊ,H°ȯY"*Yj3:xs䕴%K~LBECLhaG qįM#gĽC n乜nqb*w&rѶ*\`o1|r[;ݨqQ0oKLHU*I5 nƃ)DQSwe\!Lպw1MeJyd2.2q܏}-){dIZ$ m}cvo}bTY+h CC$c6es/#P,,QZ r >|J̈́O3. `L~ov` ^'Os XDd47acdk NTiZ6z NSʹRObxU1G}y#EH-7w#3TZI]+.T$4_&`ߕ2Jo\zgKQƪw#Mxo PPlj`[u.j)8rGd5'%)|<٦I(ٝ:` zTu[ed;;ͬhmEAACd:}kOWėsu5?9ZZR= ?L5Ks|8jږvv:.f7ZFr+^l<;BvF= 勍^4#U)\$9b,ĀI͸7q^ݙ"W8=\^x^5c-m`MH|/(iVkTNRNz?_KN8oM O-m:|cg{_2X;.m/;  }ʏIf N&"EVEMgw{wA޵3AeL6uKL =rNUawM{<'$rT?!d)NW:\Jo7{H5-VDTVsEw@As2(sx5[%sD,>h,#܊fRhp$up/v#NԈwNW!tq9A`lͻ[#| =&CIxF}콿q_U2:XhUVsT.PP-StUdֿQ/D7/l_'X,O<2 Jߤمۄ @:zc3&%Bn2͂@/(SJ< <%ъymp`'6.(Ůl00l-JЗ frJjבMyׇe|xK,y3./H)׻u7=2*M֕K2*"D)z<&g-2_HW> tlT6<|V:v^#otydT'<^Z.^*GO:fe`s'{7HIwbkEF} +̜/'Ardyy5Jd9: 1_!S;Jbg(D:EusO`gz+ё]cHTu.s|2JM{nGKa`+)""]Ne TUPgTs{50u_vRxF8L?6L.c~ᅙ?I\STd!e@^3a,)xg"4Y ˚3ɻ3`khHu$iTr 3^Q+S}YD\:D"~]P.Nq/S5*fF%zͭ1:lG%ֈڷ}znȀKE߬e֗UbI.cЍ ℘<'~YC$i35}7{u!1^G~؏"3nqVW! O>Ë́_)vZ#QK7dPKK|-)۲&,/^͡pIv v >_u$ wl'e }|4`h?fQϗ X醭U2kC>~,b !r^;@Azؓb<^w@ii@-J;B1v\6#dM{=hYt{Hfݍ)DZ LM-E %,e0lq iB$a V6ЎD*GxeL13ԑ^ebp=hUB~WgZW XQQO陷Cj:azE^k>5oڬeV'*ܤ;_T?X_P,$b>nJFk p9yѤ헷 K[4#wZSh=_Xݔ+(HB5Z`]Q |" ӦHTՔv "W3pKў?8<5>g,)<)p qlu￳ Y01 u8x-o _CMROz43:<>m +{cmS2*/InԠagX0:u pe1jxѥLIXa ob1H>S5gV0? )Bs TR %ޥ- ^pe/b٦2'>xhnt{NQ7ƼwZ<0sVMI/c"VSEŸC]I |@OG=LYi^NqE613*: k5e2}huF u֤ \ )kiVϬ1E@:y) U֓1o+ϥ m&*6U 2EQ0!^Ps \nH<>(>tF2õ^۝NG{WWwJ4G-kgfٽJXba4P1:yP0/5vK;mfCd,'Si Yu.7e׶j6c ~uf~s~H)I]p.ΓA>avTdxJXOE_I7NQⴇtl_6F?2+= g1T6S)ao9nc|6D䞡0,al^c3M{o1A:=`xsE:#X4t9^AyJ2r n65 6pFFHs$ƁYy49jٍIRsg<>Ṕϧ=ōLW(V.4rb3 2elE%+1d&e5T6ީ*W̑~84%$D:\.Ob{ dܔ}X_Gyj:|Ѧnw-[N gc@/IѢVCЍw6^ +܉<ҿO$8ȯSo} (&}ʂb *|SF7WN겎#vɛSߜy!,}Q$>|U G5xD%]sQ| G _dzeؚϟ%v.XӔ0;sQiBP*a>Y{vbo;WƕMKd񃁹+cRl4lM\kx4ˬ~1,+lA]{*&mFiv]QY޾~|j&%+Fм Kx5FleDab:B?xW/+)QAؖ [l3hX;Vh QB \NV KuS y Xgg aU k\~֪~aۨ&w`6:}7OXֹ62y1,j|]e˜%aK!L?~q>ܮMq⦛&ǛނvMt\r*Nʁx:NY=+o$ ֎e27hh1@10^>A4=[+cX" pHz: -T}Fz:-8Y7Q bΊ:sσ[,!'! j=hmG\3Zay2SKPYp'gpxg]4I|E;[/]ɝ֐ p)?d{m't@KT`9ztl5sye~=̻/AM\YP]}H4 eo$,RH2Ƥt-m,s 60k Mi;B(`F٭{nyo Dŕy ei ?YdFw쇳m>ZL] iq1)G|[9]&e:'AN4^[ZgFkN:ϷFjIĨ=_`\ x@AKsidV\^$׬E.lQX<.r$Yy۫&Q 'Kc+Տ} SjqiZ+_})ULJϪEqM6/~Y x Vq˥SRPH.N\-  i8kL(@U1~S4x\ (M6nMFue~& 5R@k"j0<k}*x&n(?6޽ QPbFL7X\.1wm&k '7R< G.o_A, 1҆瞙3tҬTL_w{/]5TH/ cei.fj3tF#LZ!z^ s&p#7*< {K,-UV;MQ{zonX:`HW0xLuHK;/ш' mueuFn˜F )6e%"SщǂCa.ϊp 2OZdT:oyQ9,C#,J- d)$ af.1T} Z= 5oLRٔjx︭+J<Μ`xuJb[V2J)Ւ h0$b ׾$ b^И C\uSU!FYk@ =Ue]Srx XXmVԗYf9V.0 m}\Iwlū7^7OI57b~X`έZU=>wxm5rԹ{ߚZ+pM Ny|~긲.EʐO^-,-$PMK2"$# '8I'J-ZtrcӸf7ִӧXz&'w5I4{q2bI&QXSvkQw^r)k5V-D<Y!O4e>~ r=3N#C1ʼ&OBʻR/ColrƒneU>vqIfAv Z][ ԝSg8l8.?YH]/Ng ?&f*A@* t=qj:x`R4~_[TI$?(WgxwX>+uU-[eR| ߔSLm2 rgk%:GbXBQ4УN7MY/mapg]DfꂽbLh'XU+Ov< S{u(˓lԈ_ߪ]+*H~rbiѡa$5'I,mA3Աn~}q JSE DƂ}nD5&6N nܕ32'1iggVh C+5'x~*Z!K ʅc,h_a!дo/?پsOPC6zJWt#Af1Gb@,?rܺ$-4,YW9P'jUV@a~sݥ:tmEk*GTK;o:v|nqsGS.Ҥ&j#A0p>*0WJ;fL{g|kbO?t"H;ffz 6>?YwMIt%}P6Xڋ2D%0'U yb;9vzB>eIS!Dr&xtb&2fU%\-O vϦI,B]aH'pIyHZZ3eP q $Ќ ޟbS^}AW۶=#6CP#9pՆ5i*u2̪˲M`P=烉]Ky0RMzj,;*p(g{`蔓Nq !~=xЧfh zĻZ" Dcj϶w? M"8zfxLk:Yt2zܬ= 2ςϙ:+1jL=/AhnܯHj0 Ckvs_~Ez{l w<%nk94r9YTb1\\} Y _BQy̏]$S Q!vaM{㽳'Y {Rq!+A8t`K|ntF|:STgjanex%*=L M~ ~V!Tᖫ!%-N]}HpʯD In<{"/FQEըcnwڳ5Js g|&3Up*RAe;4#,(. Stc)#En63̑oK%͌g>0ﬞ"" J[$d.")e޲;/#8DHSR֒Jr`YTքvoJe\U9{FSi޵PFs_̞j/ #W =dOä=UoIM"7X 0H6˓"|{hM<.:(sBT/֗eo1Up]DM1) #>/ȥ2GVr!b2SL<4$`sEPDI<&qp؇|A̮-)W t=.Pk-A\q {/ {8:4䑁͠@Ə~d?>мfۈ[)or3hi`l(|ok *- {2%-3պ+4rĽQՒ)XY ?isnnwב  ދNd^dc") 8,~ap=bUy8 XԽֽ=˨SQ{⭒}$;g cb ?I4FqB J~|>?ҬC 4LnN&g [?}< i&-; m?n<ɜ&R>μDI!A-;d.v[GP‘pc1F_Pq3E-"]ȳ/.Y>7k@+xG22:PaT}R7=T" >a]@Z:uMcOZYwΞvݚL-8VfZxe j4EBfYב %"]ʲaߚP&E xjGv1K'k>S*o)@J+Ě{JߴHJcV{wlMh]0gAeT<|;ꮼo[6)";tSl H~CkJtA&"K_ е6Cᆴa}7q&eLC9$^R7.Ge6EښieݬPjҜǪ(j(WmsG~? 2QqVkĹS4O8Xg0o<7.eL{E1NːqR'wH YfV%.)qwzt~4G?8LɯMs3(n;mΪu= ch Jl1Dg~ >2;h{=P`RzLS&kPh;ur[8hft,J0zjj|%g='G`іXe+@y]w;i˥KPӐ t&[uF|v `KZFтE c3bWwFM" z@D-Gìۛ"cpԶ2 bTRpN50Z]9,%[QĢz[ hF̙8A}.~o@ ؛{p;rtuӆ酐'>:oBx,Xֽmz{єc6X%P_(آ9= T9 mHxwIoNpF5:^euWQ-OT[[j(s!a?^쀤:<,R_;ѵn8D26j O% dVS;D†jHeSgםjS֮24MWQÚ`sS_L̴|mݓw0nwLq`'lY\kQ,vz5Cq:mK;#_Xu`Rۏڬ]w E )}lk_*s "h]&`wcTŸ́` 8TzN|qp>}\ _1U7 uGr< .< Հ|8 7ؔʲc) vЖt}0rˆeUoE`#X#"]T-R'=KnbSu$B+HAqE]z<8`g@Qa ldIOIa/8VFH s|asdjbf `XXXeW#.*`;{@57Eڰ }gYrE凛њtݸ|i4O?zv Z-Wm.Uk/?QKm5ok=!uݖeĠYsɚ~kvN&jPf4gSF)e m ~Âhz܂Ug׋ lӄ$76aRm1с ,U 7pX'P,,<7[4=U\p\!mx˻tP$?y$QAbf L'  9߆ƦڅWS"!IW9j ܚg=V8퍆 ZjoZI:McPf O\_ iBI//\.2zC9ȗ )U}Iw[><ȲTj" ڗ &C9ԕr"qw gї.Y pmyq]5irPlKI21GAꭀzYn A=:wfj߭>C-M{`"ҁ҇8n?a>M#[:GmpIهځX ۲wg@<0A>o+Ip-=ql pHGIPr+562dZx-x)e\·S֠NS9 j{㲬 u:x%֭zgEVK/)A8ܔ:4Fҷβ Sk> 8ίѮC #{kY8QVJcYػ/|Hs~K6mLӿbmZaS4Svl<e0mphFNKŁuqۑ{Lf'aZj=㍳T LiYۖ) =o;^;WUY6(=\-5W>.L^=卦%~X*X?K}Z%HdAhsoKYҏ0E" xmr+ʾb$*)7Zw@2*ȢI- )X ȕSϸkftCWWgmS AkUUjq!&L7.Sc/r R_[2PѰ@X] ŃRl`#ꯌ{aȺ@'1S9¨ d0a@#g8(YWanJ@^cljO_@7-ݕk[sT3=Blo]j~F_TCIU.Z0JYNibg#ށ,Avy j m5 T`ۋɄqщ/B*Z|Wt7D)OuX;*U0 ?箣:1MaJl1l` Hk& 8̆4{ie N(Fs^.O$ h,qrD* Nj M%WKGAƱm̸$EUx]KM=%KK g:n%X:iLL阀꣚RmAdepmɁlPCq>gdgBvv1vb)yw3gK4dWᲇ+GW0vijX\ FY^ jz0\mm2-^Z3YN4!4N*w4jsA5i{Vy !pAָ9ߑSR]rʿ#W$w9x THo<Sr| w;ыZIt;e>3b11gG9ŏ+Y@+p=a-Ԕ!.UKi.'0fyP,+ SHى؞6A͘a#|@0Xd+<8%x|2zMO\>}T#^iQo?~"i#Q>vF&H" n%Epc[ 1\:#nd˵crβ6^{iRԧ`L:U[^9G_FGt3 ʀn o3## 7a AG&s_J!)*p5PtU_bJ\{Hvw! vmcC4aYw}7%Ńu[24ʕɊ̻ etp8`!.HqK ƨ9<.Ǯb `6Yٙ8x.aigۢOSJQѯlVAhHc{LqQ&;݀Řﻴ!ak:)0u) XC'=~ eYA8J QY %ѕdfC |[6|K6ݒ =+mkE^(zro;b̒}['P}X\qH!-viDcd)T؏ gK%Ш]lvޱ ]bC"pK @#VR!k W w !nJ2Wn݃z=㋰5ABQ(~eͱ?_kwB}އ&鸃o!bR>e/[WSFPlmh g yklW{BV1pp RJ}/AbT4dT϶s!J #74uUΣze)| K?>忎/q(1(i|m}OEU-ai;Ч^Thkh9C!C z50QD_ݖh'tA鄐vRE:˜)r(-?^;_f)?%45{IyONfγ,,CU endstream endobj 289 0 obj << /Length1 1659 /Length2 9389 /Length3 0 /Length 10462 /Filter /FlateDecode >> stream xڍT-$k 85.]\![BA;3{}}jWStT:lR ' ) QprsrrBQnN%ȸ,(;x\\œnNN$: d ;@ vCqrv>_%KHH)G%PBm-'K[0$EmPgaOOOv8+j]= ou#Ogt][?:NVPO+pCܞWC@`Wsq*@ 3YV_gb[տl!,ZZ:9:!޶k!Dzh΁y)-_,]mnn-ry>e9H ޟ+ؽ9Y{'/`e Y6rwЃغdJyC|B ei[^;`lok~AuzPWw￉F\\%`[/ `{\ߟ> Oˡ$9ii'/// $(&q#ric㯮`kb]A鹕:߄XUowwpf@G[;<jNϳT📬ٺ;/>Ocu4m6nYtrظ89{7K% NsQ9ۋ<  `8A\QߨCwO$P r?7H#^g`?-]]_?fx`/%򂓥H]CXM''Y=L&6en; 4ܐM+~9K&Ȏ_~:Q> OJ5J~{poQ+pq,½TjXXZ˯v_1k\6GWh7ODe#s9wy5?DĂ#h;vgJۭ؈gbWz?]p}DϞ=ݔ0#1<қd2d$޼5M/3v 7Vd' F>m4F}dFCHmFJ_$9l~#=FT}Ɉ:^sy{wu]5QSe(f ឯn Gb34|Y47yWB$q4i<͚h#Mјrj;9tޤ]P2ExМ Rx^98*m^7sD`eEyJI.<2Qɋn'j3z 9\rʤS㔢^B? L!%q,̃ ~ Lz^A9hGA\!%%"l.45!gx[-)кA:Kd2w˱Իi sK!l>4ʈ^}_צ_k |=pл0et%lEy85X$w7#؉  k\l(mgz)2x /\/z@89M;_ ~=nbC:VNy n4TIʋyvj͚RH1HRDOHo+û8ink\UvpAϩ@&vRxf_sޖ_*TYDUMe>@dk/'yn"Jrfhc\v M6?1 fD J-/]~tL#m'y88b]@oUnaɋ'I|CގgHg$)] Ffrg<4П2%x$`2&uLRapaJ4hx3-K.b֒\8L{+~ OQ`fc/yz"~R iEHcz"Y/S-5OhSq`'rHZ"GJq+o"Q'߇ =fEVy2I0xܪ s4Qgc*jDD!@kG:8q)u$ 1 $H0/<xɃE@HmkN($)z_2eБ ҽdо!wZ"W>&k<6sL_K~͟ÇmoTFF31J[ 8_"hIJ|.!OyNayWb+=DXMWHax6UI֡RVe&EziJKVCk~st:Q4[BjkeŽj됲Z oe!X֓t)oU=^sRCSE@aoo@QEERjwalȃZ(B)Msi5,}F5~wYC/eGP'k&9 ZgCr, 6x_o5 G2_8sj^I11$Gq)g1ΊC$㷁.E1&>]&򪰖 nfSh:KTe{hP6VAߑ J=2ڂtKR|()]0k,^UlxJ9l7=M iΉuT'n z}p^jJ=fƴ YF X3v[!)~<-t:܆}GOJcmNZ [fR&paJQoB &Na;y!I*}2lRbB|bGf^^MO+o)VX Jaə=٥=TDcpAԦ-x=CIrܣڶ(]y#CTV_G;ctr }I`jV_?,k2D ~Ǖė$Hʁޱ߱S[v\>pl&OBI#I5- 8 q $5702Zd لUpQHL>nytԂW!z! +W H+@/Z g88%$HC\Fx/08VsWk[p*J@7v1hBgT"|Oƭ pW9`ĘRhx`nr(RYpY.%!GI T8s!^x_JBJH]ųkcKcn"g ZNigi#mr[N!$>4}3H+f;1s _:U_T0EڼMΈp}998)ݠ{/GwiG_Im֊y8y[͊hF6ߤg RBy:W~;tHݢeiCrwpȶ4M6hC]wOI0!JY]b~<UhȐ}ϒP(t1YH={obAI`-o@ Y7e*KSE9sb]OqV`R{ܰ/t$̰C' l[+[BT+J{_$1i=H;;K*dE*xӺB鋻"&Ɠx!} X*C9pa9Gۍd^㪿WQ7grf ҵ;b oun# /LJeΔa 7{բHv &zMz>O 8T*Ks^^a_h;>Wxh~aU$l2KЀ&9XuI#)[noz=ڰX~nG="Š؅_,c_m_gKx ZOv5!26쩑rwE\.L>"9 Sǟ;v裖w#//Î\W>,~c)`?naezׯɴr+,6A"m/9[lhs@~lJAV*\ce'X~vv;ǹߌ]+y,V-zW;뀳W z3F'`k,9)m} a,AFCYCwJ hjp{śM[UC/v 9N6~!Rw6fpN?|V(ԽѱfJkm򅩮;gϖZ7s):I}m` \~ T|ޒ}~1V4B- \6Gl@K G `N "m[i |BǥfׁnL["ۀN,ReLcC0jT{G>C[Cg+˖.9 e>)מ[*G|,Ԭa}XgZ ; Nj=+BZ$ZSj6:K9P1縄LT,ZSϡ7'6!oHnͳ}'͢ :#Ϗ"wl|̎YiH]=D| ~l%Ή7q7|*w,,7?K4~E֕zREf~t:DUZW~ʏŶwT1ұ_FݿjJp0!>ӫ` ȭ.ކFrg; =eL^֓~\Pb`X6iѧP`l$QBIz$i< B"Re|Od.uH,lz3򾌫i99-,]}/yͤI2zK"ZGҝ< l&WZ_eDSK? vda+V.3O ewV8 /Q>`Kt㶊a?Ëo} L2ɏև?fͨxp o v<^? _ \%"̐I 3#lAޓZRغR2q<c2GEr fa*oSkRIۥy5$~:濷o1caᕶݸpb " f6gM`76z:zH 2q[cf3ꄉ>(F5mP"pL U҉fl¦}N=!g݋@ G?uĎp,\`^yQW  ]QФO\i6ķ*c[%bO<[o|`9x&U\*ّ<5˗rdaG!jgMZ^?Jx y#c $4ԃxLtI5hȒSJϔDd $k}T5U[>"G}uc@\,4ao H&Q RkhZ8*A'ZOn\׽-5^~?k+KdB۾ȫxk?X4ZB 6cYG"qPSjb0UAY'B&?MZ5/̭34VVz+ TufR"*O\Lveܔ;Hɽ)[`YX\m D:yY6ǧ9+zCg>BcUQQ8 ʐlKAGyj$ ;y)h^lϹ}cF$P<o [b{7V+J_ kOTW !4o[?:KL}:aH#[<1B\ ֜֗O{%mv W"4>8=OX992+: )!X`wG/\ 7"e "sc,Emt 툚[&Īu_FO1@s0>策:}r 0)\Oء5RxI.wQ; +7(pw(oT[))Q=n?߭$`B@7ƾhiJ±!cz.m_tS o\撔v-Qxz.65t8&"6|_͏pD'{̞<(Ա7|갡wW:MDi<@2W!yjM, "ILBͶWr,<*l.'}R˅{&9w$[RQWioE+ C{D_?gŘ"']D][؎Sf⣩Y:ZEBݻZm%ڡ5su./-T2:Xݾw^a'oٸ* ZH)~"HݞV+U[|ޅ֧q:۹QִB2L`3w*Lvdɍ5>'T'2 䤶[`<:TET]A% Þ`)}> Tjxpn$Lbt$mGB=*@ak/#V89n,a$NIe^~P"iu.MFFiR`%?HU q~c= Ctۗf] w0_^d+~(4k=Dt12IΠw:C~q]ϭ{" پԱzp?hSAEoKt.Âok$}K-*v`[@(vyF?E'Kz !gY0h,i -La3EOZلdxju{T91T-̙rxI\ӹ0 wW򽓿#oCi~zuM:2:1Iݺꇃ=7T> fDn aT?BfR*" )_I&>Rʝ较ϷO/ ^=x1zHV:-?A]庅7I oPLP;O6Hel3#zg,~3K](%;1K g|7sbu3wOᨘء8ӟ]aI4Ui` ۻV襚[|AcLSt!y+gEot/v:ּ""K9X.`ږmg$t?VMVTHd]nfX2]Wq:ho-Ԣz-ie^[i E!5ІZb}KCW>G=~v͙dy>S,1\|js߭Gȟ,=#'{1C'H>U}KaMw|f ,ޒg2ou}H]fb1H1IlOGUvpJyIs*"$4۷au 'yË^Ԏqq?QcF| ;^tG0Geݧ:̲%"GhS-\{ts[詢h-͉]'\qc2Cs9LH'dijg~&F^ NJ4&QfUd}> l Z͍0HT|poҘf(8F+Z0-A2:m[MLЈG|)x)8~Z#gj,պ/=>ED~G y$gu\g4%.F(ɱgM n0R L(.WucڟqLR>-*0F(A}LO(C&` kkcO>)`QJ)b fk]d";cQs|-&v{RkR Z;h '9_Y84FJ ,+Z؛(dMlZ_jX39,O[ U&oS$bcmkۢ7=ga4'(y|(:~EDMM 5Q9 %߰7GOsK;uAԔ'(+$TҾxX۽|5sij(2.eEđ 1Y8†CRWπ)pQ-JxC.҂fJ}HO^EZ~n04^45R`lMx' W]]QEy=fŢC#א:_k"F-_\[s}~\xUc W{"b_:r0q{ɸ)VR#JBJAA[ _L?g"*^cyR+4%V|W)>6LmFQ5%_GE\J?6Cz;FG`9GfH*+:ܫ3a{JAҙ>,y!P;完C~:2gfԭn8ARrV~ٵx*{f DwFZ$Y}'\90@|8 |h ҷ<bܷ}4c-6T ^ow^Ha!ac:zMH˒ ue)qf-h r*y. `"9Z)} endstream endobj 291 0 obj << /Length1 1679 /Length2 9936 /Length3 0 /Length 11012 /Filter /FlateDecode >> stream xڍP-CpiB5H7 ݂ AydfUUWukgi)5Y%-!@9ؕC fB2]@пf/63ח8Ufp q qp88qȘ,l%B+ qrY۸#)(G:@ 0T\m/- (Dl\]=<<\ b, @ tvZ~ 9TƆB бi׆Xz9/{:^U@*'te&H688@`kPSaste-ٻ@^@f/ ' 0{< g D4/, 88.('rZl'kx}V on`PQ毐?6k+_t=-lx9pr6(q8^D@V3w o#NN%`Qa1/ s'' |eU TOJ arryx<f[a06V^?2 & / 09x9,^8]n?므Nvs} Ul7T$-AnUt5{Iry-5@6Nj@\@+'^>qy9?\q` 9;yp//e@-t6 q}IXAQ~(?]O `UAv$`qt/;_ n/ ` A/@Η_ A_ 9 0; 0 ]_^ y 0{k-ܜ_n?h@O<}ZKWix( BzF9X<ui] + emq1#"Ts5{7M4-Y{N0CM켜^q&)/#d_:i~vN 8G >>7b7ZaǷx=ts?*==@F֚6<  ŢS7Ga>d6c@w`yG%%!X>PJڥtXϜkm6uB$A>01tf$"ng,5t^H˞0uMU{ɒv|zE_{ 57-Þ,.Hum -C#ѷbx88͈1X&&J넣:EyP~}\ W@/W0:.p!̞YCŚdzي@I^C6`Mc?ŗXʫK9﷊y#߬%w7*hE:L'/Inb&\<('qԙUG`jݥpc/?o1ZM,⣤AO\y\[XW7RIPmW ANVU~-d_(#e&/@̮nEQ>mછ)%"܀ౣd\5d3I*O~u5֕v|*s1)KalY^j4p()A".zCoRt2͑: 5v;&aN^3x-ԣDPgm d;ĕwvfe  nblc5~[uϙ˕:nK_{55S u JS[!mW+$A򕁹#v'zx؊%-L7̊Ѥ@Rj9;ak-2%׾!pT;L!Yʣ2:PB忎̅}A_eԠn)X;%m%+Vᳶ5(?$,yW:z2pHNq[= Ԏ QXYzxw6?-dJ؀#ϻ4 YP.|,[-)EFp#!rG3nѧ– Q-i Zg9bS\v1FsŜGz=E"(d~j W~e!0Z0fQYr&FEBkQzyUA,DD{MY/G #  tϙoKEu_Vx?5kܜƅjI l#@BG4(Iմf@:v>EOH79GE d"7;ͪ'*T]beVa@cCo ;(n- kaZSmyi&LS`'F{ui/ry\/qih8U]=SS銏6RygTàGv|PVRAEϑkf7:] TgV]s9}|Аf-N2!b ><)rgʟ9OPXҗr=% 70:GtiXbz#1aO_KUTN9=kbTV U'{S'\HMbCo=Z_yˍ[t^Dz&EHWtLJa-xӰ؞$Z#"Qr#ZNگI1TQg%hJoB.%;i^(PFDǾ3I 2R爹}\,r@yCl8舨ӳnZP6ˍ0'_#OpL"`؉Kt# @,8>SFD辬!|BvŶ 5kEW8GмY\HIb9G#AN_=p4)[-[nAA.R}땡xF<"w7UiVDؠ4qz=8OT4]G 8(Ӽk:λ&o/2,d"ऐf ٥mqi(3! U]pN>,O9^52_#[(iں cv^-{ Sr@y)`j5ab\ŕ"6s .;e) X0Ge[ ]Qj^t BrS ;w1J]<|fQ;`]N\_ѓCer+jdoao-W6"\"I֋ͥh*nSi ]؇WRK!W屵l!y nĽ%ј6ϟv eR)24T|nvav2I$ԲACW蔎os- Ym@kyŃ"#qYFM~_IU`kˆx.>sx=~ͷC57!0iDk膃~6]02C{d@r\}4=HQyO}}%~1?n$5l H*ǹgv'F# G E'@3n4mH )i 5 YK9ՄKvT~+shK#tfUy>|d~{U(Qrl,wx.'h[]!*c 2-+0xH! ܐwPhiPه _zT pȇ,s*ZK"PlVNCQ{3=׷cOx`.{,%V2(;_NCe s(5_: kuBTZ?JM]g$`٫ήE,*ipNFȑFfn/!hrT."HmhVȕ"#~5懹V'Ȥ-ysTpQBE5DAkAe t'\O4OTǏJNg$%<ykI# 4{ĚAN.T>'yͲ qoP#iELJ($]&;ǥ:)/?%κ]*N_zEr~< 5 4ċx2<ͮ9c˫Ti `)ke %\5yЮ%EyOXW]@w '-u#մFb -YʕQ8Xe䋍>tD buH->1Mw;yx&Ψ, kY~m̺SXZ1ԟ]. !(.؛_3{ѭ]^XL $rixoy0޼Qq{R@y\ʳ!pSЏOMFn eq3[#pR$Qݾ@r%> = |nh: $1]׈/ӛ3\_A<}ﴑ&/VEhp;Uɑ.㨉ڑv:b_bj'iL;j &(~L5(I.UO|[9kv MNPD&@RSZ QF*ׁBŸ} Ϲ8"=S $wUB~C/2Y΢)Mi A\}ѣ?I,0xsDp9ULڨl"?D&]!\b 㻮eua%;enZEَ^\ܽ/ADT?FFz*6D1-<*AH vPZ;3%qԮLj'hʏfϝ52R xS$p,3@ u5jdkϻ4"M{J;U2gGZķ&T[қuɋqcrˋ_)nsuR2>bA 5|cP"N x<->82nzYz*y"grhy\A/Ӈؑϫ^7g|l5A2ч4S4 6<|oK4s^K )Iz?53jXV[m]B! aU}tة1&0W];4̠5uccwL uz@wTVښRAR.A$þZuڊ96o?Tb,7n^*w3o+ j0N\IVJێfIVn& ޜrsǟ{n]qZjohгFr,t\FqNI4DCzJ m5Hp_.8e킎W:j 0u4R/v:\Ld"cܚl猃L,H]6N=V~Tn.:0 :"6@ϗ1JS Yo]*&svv&z=*HJLEsle;ؾS,b߹H5qyG=TL sZWH]j8s׊!={7I1TE"$%iolp6*\?SYIi:'\5:~$eqk.维w.G[xZ/ &CӗrNx6Xq\n^&"ZV5פbHxw [Ry4]`#Tksምq-':GXz8N;ٻ M5+|&3`;ܡ #RTQ1 {eMp=3G Nސ۵evEu<Ȟs.$vD깶^%.JP%)P$~IEHCw5* bËZ)gR_P4PY*CNR`1E-0LIJR@wWU%кF}5KVfKmU^QoQkӉCZnO+Ond JM[RJ,뙳W9)+TO -wW-U L>h4&=(y)-$0鈱}X]#rYd.}J4Bi{b$s5pD \*1HP^^iO>S7;T8tC]%NaM&!,EWxX Zv*i6v 4xSpLARb+9=˸)jܢSf'8j2'p-<Ç_W]WhbHɓTJˮٴh3[b8 H,mzsXolV/. >>c⺬C`%$8D-`jJ S&ڼuWk*J/?Ր[o*QTla0GZwFn|zD^Q<Λ&'c:87F|$(L+H nLF`5X\1[6ۅZ`nܰJ\&^Y窴\I ٷ=9S ֭mZFLʤm.* d@8:*׵a_BzDٿ$^R=x*QhSб>% MdR9fiUVe3225wh$GzpC\yEUc"'1& R#nܴSg*]_hl3&T+[TwnR渖 '7۰kJj$4Ŧt DlIvʿH.O}P8cgYAN;:-8ݑi sD:Ee bfߥ¦@%ۮY߰7sx$,cBqsl{DBR'2*JϓCHꌎ"5WL^*hWP$Wj0JJzm.Ǣ{izw[@DC d7zf]b{j=dp4Jhaƹ(bP!hbJhSs(Vo}xotb?,1W%)GAoܘd%W? |^@E33v.ޒhDT I"Rf󷷠*JW@[$Mk|CJ'Y+OT6Zk"$$$9~i0 qɲF"{r<{8*>oW x>a.P3XQh Y]>:YɦQ"-цK Hymsov{D&_T,miV&if h8CLJ'RGz:W8N98fqSW~fX1]i C8Q(<]֯[YCRߤIKMPZ4. ( z+r~R.)7`2>QJe~XzNiU|ԧp]Jom=ț7jlT)0a/jB&xP S8o4 ¯te5ĐcJ>s  nE629p)ffl4ZλyH"p#M;IVVtv!'k#Z$4PbpWz^/c)-|14R$/՚E[=ψazėrϝ]ʶ×hĪtiW7$}haxN o| 5 7$2Ky:2)W$ D F<:ۑ6 ?݈e g%zu{LOF[XdR!ptvU]/wxⶭ^ڱ<%.ީA"RY3ΰ)Ȑ8 lO$/95"rV콀,iFM Wє˛771* >*ɀ%t7j g5{2rH! d[Y*Lm*eZZHO9ZTl"G-346֓L T?!ܝ( {*=i2~;`#%b+ 'RYjuRG¢Тm]mQn -VҼ"U|bΊ_/akffK]ÿ8B>G(Y,3 iONN/T8!VT ![$DKfzqw<ڍfM4=QT?/cBd] aC5*yty+ku_B5&w7Kk ~0KjebSMzj! zxV{'!2kϾ1X4J$#3Ny*m`pmU&urTfp}qrϺws8D\ `B|$?n6[N:xj;֭^jE'3$*7š=oGSA!ސRU&ֽ-c:%̃R3Gt85S&?RyWкLڒ*8K)s3NWnj endstream endobj 293 0 obj << /Length1 1516 /Length2 7343 /Length3 0 /Length 8354 /Filter /FlateDecode >> stream xڍwPZ5ŝ\[܊[ R ))R(^Žhw  wyo2^Ȫg(`"( Hm DA a" rMHw.~%$ƔmP0m ` i I@JmN/}?W+Mm<[D`0Al08?0y$`B  Dkw'wsTTU~ۥ b ,%@/]oq<蟊p{@ 矚s\xA1-@b  U_dQpv6.0g?h{@CM 6^ z2_"] Ӄ ;P=;3@C ;EҿTCvfNXL`D~`pA $G)4=I$?(?= -a4@H Jarz_Q46 rDB#F1x @4O   2;n{ MLy摯=~g慮 +d !_}z#˵Nk#~T[~UZ;mhɎLw_8abvi <$Iνީy|_!rfMV\rB 8"| Xd?Mφ`"<&:>IY0zâG Rg*x1Te$`Fτ}JaOq3Sny C4O.`Mn5s#N476F\JzK9k*h抷ƱD;n*FYjuݖ>myRr~욌[R] OwJuZ:,8g#3  @/q!jE%MT"?EڷFﶺۚN\IMXBal)1֪$fdpG-ӓdFOvޖP),,hx95|k<]ᒰuwp}%vZ\^i 19kSÌ]_Ru[04<9Y\oF7cֻ3AmSOzStȡ9~s&zmJՇ+Hvcؒ$c_!/#ö b|[JIn=ՇXʆTpV̨uё׫'GnHXf&[Q9u] S6VfCV B2sox9kU"\f%eXLMQ&N4sBU'&Xl1B:F}C봊p*k`\3QGi"m*瓕AqLRfTv>(D$y!\}n|<V0Ä 9>7 o)w4{·&񏁼*23]7cJ ŵ6g>bK]\>D%CFj!0 5!ЁOl׫{ 7L'6$LvW%Cr[fiXělO >Cμ@-EX~ႃV]z-_Tj밎ў|z%}@&U;GgRMe6E=Uo“,WoYMwo»!+| FHN\bP!*wP-?VքVDp}~9Hq74nZ43rgcvj6~1e-cKdCAWE$_a\yxI prDLڠhX[Q$0لW<@כdeiq/ K,hM7LFU@)gCE1E@xwU4cZ2wwzx]-qPWt>999~e\i*_quYT?ٸZuu73O/|$Nvv=x{[par̒c0ޤ%{cq>pG;Ƅ9ntՕ*JR"X&L:*Ǥ%ڝܻOyZ?Z~"1$xc:ro7}YK|>u76i˲ 9 xvcoF}Í fj!/!rSQIޮ.U~ydr@Q%T !֤AQ;t!"k JRbaJoJXSrs]%p9E"$ 5}ʡtD-==E<]'98Kրm&^- gi[`""{iFӅWMLhpdqXoVK,XS?ށd]=yf"smo߸\ 9 _c7r0d~jcm0!7n3݊e΂y4LqފXS{y uXZHГR#DJM>Fb ޺'iP;!^Co]E;=&/NJokp(3{*6z\uSdx+[2ӽ#|haƉ27 M/љzmTrs~zD }3;;$okyBiMٟT6v67$.OƎnw=' .*-ThÚ [-&Ġ2&Vi6V4™V wO(S?݂ Ҕ!4@WHMG7;݌>jA6׷$*|f:c\=ʍ>~52ؿ"`iXdHoިJpP[^ko}yUÉꕖW|y{SjVu.1:!v KaxL vɏ4)%LzOspՖT+|5:oj=T6[4PtzjST멂'Z" h5~ȇ1x@8+iO+=) dDqڭ8P}ba2f$9ڻ7z5O2df Q& [Lx)ffً̭uW}1&Cc2G^y7ƋI"Pqgu9xw:BvlH+Mr.+z-lK!q ^Rr;9E\uaя!o忲;u3ul[Zzvc`P.N =JxSLNXx|SV2oğ{H8;|$Ư9ΛFڨ[e 40CF2KBƯU^\ d@3]^XpgdbQGBh$xFwaHw\{]]sfW'ԓ哋 :z驁p JY{|挺."4)z.v1[/ {ˏv"}N d9i.~!B[2'W4UD{e^ӼE4dzí /*f-)*vO&F - |׾%kw|/U~}͍ ~j {!+<]v&po]qΗ@-٫Jt]K\N|q+fY~jlx5S·AcD_/}r݆_2>+:tUФs[KnUe9o_3/8 z1v\*PRHnqy$\H.KistCdŋTB0Bm1?hio59u#jVL-.=ɱ|h{8c[},sgU'I8΁RZ8?.7z_51b_1uFT;H(ph~(uN٩fӒQ~E'>N7Fdz#߄EEZɴT5SǺr[U\KuK22űz/sX=7[(ڣv]B[p#Y3u$"!`ݐЅe'Y>F 3o tD+QT\W((6ť܊*/k=؊cQH۲~\R!D!6]#&V;|jKSC7dͨ8oF^;Z}s{f3˰;:.jIl *-5^ x)Q&&M7(g zcm+X*4.q,g38CJ\G5ݴWTnbF0cg֤d,Ԭ~ jec=аunЗ uopƜ7 gTr ϕDChmB2=)S.~  uǺІ)i$UmVw4>d,qfV/9(i'?x{5Kmn5s8# >(*š $Nu"VcS[u( &7%-3l)rȿ#N ٸ?Po6>)FCL*[S'JGD;`k?tInhX,rv_wUqDE0;g-Yoz"E&Vn^v.\[5%$O*`.;,340S R~Z nz3JMpt+s4_ɽ1ɬw,╉NsQ3VO\ܤM (E`9:-<}XõY[Ow= s=My@=Fy]xgivܪFQ]"\Q0 P66wO4jdsT*yYfW8}ן5*whF/& 00*}& o1lןw̽,4e66?&񌰅*l6U[GY0[<,۞}g&c탮GDT ¯[[W/nJoJx}xg/W ri֣lVx:Ng񨏐سQݏI#0fݹ=WS]D!6}[лGbff$b*ݣ:5qKo@$FcWʑ)* ՛ˤI_3fmgr~~\/=)6Wf1uNjoa-n]K[ρ%nKi"ڊF%46ͫHՠ+`*QHEDoˇ/UIϱ0S;taNV O_t|>)\:yy} PN=fnN!5uݶ L* 'Wũ2&~fjNp; 7ZT}lo8~N]EPxImx&<$vAkeN=A[=zD[`k jbl wӴy!e I0R!v'ײmhZ pfĕS(yd~,~;u)2'_b w@E WwGG/G5y Z(0HzЍĐ r6 T[S]<ݮ500mϫK?;=4[KE4*v۟{8̓#٧MO=)s #zu:q4)K>o ^p?y'MEeWQfR|"%fP5oA#JQ#VeCg{ălL+! _S*nN(!]֏M0᧎1?vQ>ش|ݭŘN4PoW LISX`̀Wj ݿV&x'o-t^p[0Es׳B9OTڵ?-Ut\l5U%jޭ񓃽goŋ2.b (.̿Pǥ[ ԝPڈ}r;`CLtcCv1Cr; >, Ӵ#&Ǯv{5X{䦿X `"0^:)j/^siGi/Ct#Ag/CnsrOW՗)7ԟIDC^"p' {O1 Вk(xp*p}_h%Iź@MlEN^ߧ-;r,dG3K{S"p` $omlQLe:[{Y?r,=¦c|֑HUM iNp:zjfԴ8]v\(6W[wHjV܎Hr"knM>kL1N8)3ی7tYEWDTgXw: 4(MjCS"9)8~j xcX0qtiDtߕ gFk[s;}$<Ӊḑ;-\,@FU͇`̆ȓIyFjH3p>QLQ+d3ǞV?z[vPFX[5r]2q>Bw)yy,/%pX˩D;c(^Ɲ"=LXpoBymГ0&ynߣmLÚ6Bi%-nA)HFﻮRQn~-A/O:,>=njUcBPz'ϵ{H$Ӳ}?-2яܶ\0uF$ZĢJ>0 =,"b9^ԕ;MS)_6I^{\{]ώbKm.ڛyP?B endstream endobj 295 0 obj << /Length1 1484 /Length2 7051 /Length3 0 /Length 8046 /Filter /FlateDecode >> stream xڍvTn6%1:6Rn$0b1r4JR"H*"H7"%!! H/}|9\wuO0(BdEUh B1po܉0C1BPš~((0q ]8h\1P408t@c8Q_WCIWD`( "H7+ 42aDP/G  "8߅CZ@(_`hO!W%k"]Qp$> z0w[=@$tqEdDu5A178( e@/sJnmqa}P>@Wx`p on$8g< i wsAV:&" cRSCb@1 i0as@7.CwwK?O0Bt  +{;4wM?dh{y 2V7+/;NDpsoW+!6 ۪&C%"ApG@  /n`ש&8nHM$ k$eP4 5b!t5$Dap!@0+ O\%\8iH?_@BD 4a?1Fp~B 8 q qjU@aq5Bb؏VS* ы#Ռ.UMC V+4sTf(㛑'[,TC/|CoFy6_2)?};fBF=$ BǓktAGt#z"{OKO&CYHu2_#<{7ƏUc-{PB&H^Oȵca)_5dB2ʇ@z}|AVAW+2 z<\3J3,U\ JNSJ-*WὮ o6B]@?R^%MTϡ }C d0ٷ:xOq9m}O~ѴuGw?aiH壒I4ɻKyvg'f8ܳ}:tlNGI)2&P $޾O;{M,M,$WK^[x>7x=2Dw Ӛd"Tk[(A;֯uT [B:4UѾ%=F~X89at@ Xq4kxs12,au;KF/ܷ3JvZ‚2 ͝] {)E’媇6"`E]dH|bA>]3n8un?dtuD4 +yy>QE u8akVP?\80I']WDr7T=2 "sg͝8M,LV-EpAߋs8fr'ܚOSk~yӦJђm)΁љS<^hG6*\ g|VQax4u-vu"{Qwig[ UȾߢҞ*{> S = 9+8~w%ug`,2g]YSKd;XЫ 5J*9I{OBerʨ ]%̩sDj)ټ;%WXGwѨ*ɬGWA \=S~w$xʪl3|Yϟo`;˶>#>|:VckLAC4l MovZ/mw~ib%A? SikO 脿 Vʬ)ZB4bs9E!ͣm) o#)&uA@F/I Ma{&^"K-pIj4bgdo$O{qKdZ傇M#t!gg|iM,*H~8kW!]-$3[=?,<|K Xk*ק {<ouMҦ2#-. E(\?8Z &HFgnOaw}O?|w`m.Xoݴ/zn /(~:S::w?8i}=/O>}6o|V(Xa w<>-O+ h6-ǀf9n<{Vu{ e͑:ꄏ7H^zeOaӆ#36*2G[KXg5|Ho}? =׵uy CU ݻ˔D.-'8p񂆖B?z[$jsK7(K\jfV]i+`$+q u$6ȖZAϼsD֥7z]8O[ /3oC~ [DWc)33>~֐m`8o>γpyfh#+մXu&2}M6#yҐfJAbhAP6+΃:}Gۍd%xb?26dl.0Λݳ|+zKQKceGկk%LL&xo1 WWD^ޥtƋ]ofPd=T9"e8.nNgZ$ѳ@CjSv#^f Qbٞ??HO5m8-t,Cq1caLuuD͗3>C]I)1_QM"Si J %m-=iYuJ"Q"Zv.?XPS|^Bc7):4PaW8ތ9IL5ʡ=UUbیq#PݖC _34Qb終!g \GkkVo߆)Eh`aq.>O~ (Eb "9 )ug[\$?go%~oFZr4C=tnsԽ `(@8EIFo;kFұ'"5(f%}\^9x$>e,y->1Z00($PRƙީE1k{~Gd@qҍl6s8wbGïe J3Af-</7Q zW2j} K HcHGVN]o@ZoMU>z*{r1rli0gE3sqڳC0EC3^e0 CbwPMڏ]R4sF6>j0^H'0T,C5RA U뮒Y @dVF˙l^h9iܷ' ˻b#г>%?7 Vr7/&|~+6Dsd;;6~<|Y^2rJ=8c Kː -XFggLNLRU]srLK[IUbwIw'IN"̴@Պ/`HH pw٣*hl.=Gɪ# {#St]hө{BFeJ:L*q)t yvޣհ5[f˾x)M߷RWgQl?ȁyD+zd_h\nSΤܓeoXIJ&}&+1(8YUΧzLp?.ETw#9YU6I)̎yO;J [yT4ws~K\3uqw.(yWȥ%¾8މS^X˨\3%V!9|b"j+Zkl{ `GHEN*aJ&{HoY9{Ufu}%}3MC/Ջe{mK5끫TZC\q-"^XjT(L}p /ImZ/8>% ΝWS J}ζ[Uoωqzgb'34- v5fF.Lwq'ߥUH\VS}֓vYgjw$FWe6Fr.D[-v,lص!;n+uZ^}kpR5~A$lnfϳ,-dlh{1B$sgijA&rfn)->K}I_8PA,ǧƪ[aR{]p/[+X徼DƘ7_Z9)6]ot́,hrrOJ+~}U*!^| K 2|TWЈ\xT(>I7ws<7>k vz⧤'l[ڬ-3"'S5v3`Â`Bu;1orv-&'  wTi9}24'4R;zkE%Qj710t腙^zHƖ ܹQw 48ފֱ"R1us]:і߾n0DD H (@7(儰[qiSUZu-VQ*@32^ը`ɍP wo] s344IJ%\ےa1ҥ;-ŵ0^BS?x0(F{lDө:w8aj "~򐤌XW2S{'C7銛fkQ鵬v6y5+H8-iײ#Zd#(Oh?5({:3 91w=>:Sz,GvF:!p .C-.WkcF&$wS.~Y)gw.Ďނ#$iDj/,. ew^إ‚ sh  'iSo?t_BzJҊ]C}%-=ȈzĒJ~U@ M$zm{9F Z~@ё4woC]o/ۚJrAf-֘>eviCt6wZ-\yl\ScnY{/>(gձ z0@Ƅ+(E@JM̭zgT4 vce=ˮ=3W*, yC:RKw>~JR\˸A UVv KԜd؉Lqt!Fn$n^+.oqLWVʢ΢$I[`ѷ,u>gnT>fMRn( \i9)[}OGܲ̏0F~ph]fnu6̧fWn~546=tbJZV7MFZ) (HyDeș$ȓi&1 _c=yf' ^Wl\ :dgY`};OHuE< d ]cSv')>Jze*F{y4&h8Bdkknl{- P1ÓҘ7G&Iȥ7gYȃ|qOOV|~M1#;W_<>Izow|!!W|lM4a)(N}؋ky.Tf>v(Y,0J_h$7E]87 (\q ͉UD&6nh\i%"9Wyw&&Hߝ F4m}{8j> stream xڍt ǶIضmxbh۶4Vc;m7{O{7ҞsvHiM쌀bvδt \aY%3)5+Ζ#&b&kg r02ٸٹL sZdRv@'8Ra;{G 3sS 00rr:Zd ́6'Z-S͍ٞƉьflP:]& m #[8cV3uv3t @[[#l @hO?4HodUdCcc;{C[ [35 /&CL05+==o1AEỾs2vwvsK!_eޛ,jk"lgcuv#_?ߦ&I0qWppJ'ft200s29_U<;6񲷳KXy9Ύ.@?&#-f?- `/2 ))kIP-_; @`d`goWVCpc]QWf?B =: ?)f*/cX[5}]7B}/lo:%X_fښYD '1 w?;x/oma Ts220[?%N7 J{_;0tt4{w b|_Ns s~O9ullo{oq)Fyʿ ^_^7zbqE>c;w_ݤ72聿!;n:VWNz'oG;^w5wao#g{-"ߐ]ߟz?;STϱ4?NwߝNOҿޙ9Y+F?;w?;w?Y艹@Ϭ8:EW_? h hgŲK} $z*%ײc#teMM[>QF萶'g8vXS' x*/jVୠR.H n {5l峴Q:%yFY ia.ݑonr|N~0E?,xW09`~6>C%t,aɫhqh4=R ٧Px|˛ 0$%`)Fdp MD)K;m,By+t'acTW N ժ |#T1+FEvKHDDI-cGO"8dT.jF =J[ROѐD=OU-mױ8(Dܯ\>o5̻pq।r]Khf;} 3N Qb噘9Vb-⟍w;Mw1-Mĭ^˾ \cbcm6q}\23ld۔Zp#ohlv]wY'6I %T>~<;lE4v^kK0|H;lUOPd &DT)Ar^+[I:+F.U 靱cl<-BsUк]2E'b!ObX "ѭ㰯k} 3 EHVΌB4|?O q! >^p&$Y)ޥq#b|lnPѧ*murc6} NU?rtdƔ)%{'m*N"O.\-PJAm( y(9< tzduxvN|cڻj8,<%VSH+m9p)$st$fO0QHQ]y/ˆg&.e`\_ ĸz㠾sR1r޳d-PN< ZZ^'pT=^T{Z~?'1:Ƈ`AgH-"?m4wƚXvfm Idt?%R=PTKt͓M^G ~}|8o.H!F|ppig*)%pEpIdg뱡~a?= wDfR)o>5\aD@En̰xQzWnkTAuet03g*fe'nd*seں"f}]FtgfVA18FF ݃fK~_ӤG+\cJ_F<}n+]8]gq+x+,*.g)fSŜ[c<oa:$9p?b(kbDqwhosZnU5DtK:Liդ# ёZG[.1\u^V< ~> ^j݈{t>Z(rjc)Wa$ۏeu-_Mbr a{掖efg&iح#RTgEgSSQmYdsMbơA6'&I{47b3K=LQW54 |s[|+ȟ#st[&^ [0B`Y*c\Ta+myI>mphdLPۓZab7u0ػFbCF"^Jm:6ugfTfýt| d}CL)H .[#D?elwzcu{$ل}:`B>ޔ@"vP|KXVu1%u;!0rttv՝7ZXhϞ_U'(iq3BъsOO~x0AanŕX) ߜU?*r?<ɌL*9a ͏UKe]LQS1qctr_ʦr)^Zx5C?L m[^EAaYWU4c?pi{QT˺ۨA{uXY!Xo*w{djzyX໲|A>*S+=f#su8ȫ~<_FyIMe77E.x'$B#0u:p|~5#HsqֈM}š'5h>EW"g}5[𨵽u,U0 -uh2,QOB]^[(q*cxb4* H KKx7nDXKdij 3fo\=yuLZ_.,Ȥ^-%2֎{K.忑}7Dx=h5cK})O40EgܱYLMEG^Avgvs hnU6'sMͲ%_;7{VD<dNeDiX{p|B xj1'1ϙ:Ÿ Tث}$RJL%CH`bd&mI^H\)E2` &};v@Jt@ =$W ftnhEtB\ڬe?Lv'ǫ)ݐuDsF|Z|ц2uO-}ˣ}0P4 S[,D#?ټL<:'J ^ƴ'OI%-Cz0;oI4-qmZ  (r9x#iP^; 2tyt3uX|zn|UBNT2ߣE#0(2-^i\A|ֹFRV-@:{ ퟑƍ"0EUN4& JiN2[̆E<'Ƨy-ĠȞTfpN ^>k'H%<^) ab fuϯ-iA`5Wv~ظ8H-PhSԶfH6ՕX K#W.kW/L i5$ Op%]R*<ƋVк9 Ib +  3u9ᢰq@Lļ7cP.>rV.J(AmیOWz@ulN3"wq|X\d hӬv7HGl^Qr*už_{F>H}Ŋ-ϏsKD&}l5*pfmβG˚e&#mS A6ʹ ޱ*s$ëˊx5_-l6Xg1:1Dݵwo֕{F5߭V 8(^_m3xZW]G+1EI?rKn.6/Y_ \>5I"C uF}ɤJZz#mm }ԅD8nmh,y(^OZʊfb3uko[z؟;b1:oH_0Z~^Lź<ūlIˎe=?E!N)z|_Osoz oY rcwۭI].=.m9ȳ߃'M7N>Fxh 7~JFWWcaGp\S(ߜkx'{b =Ŏ\b%ŞeFb#FӑPm]dI~V9mϥϞb6)iUak6*߼>1kǥR Ԡf:pYM`þUxG8˱ގ[oXc6hH&2*|]"V8I㖙NPD!w6)sԣ"ɯ9bF8ì01ف@לR t19p`!ň77c}$~P_CMLN|g߭>OV-wO]̑~ $ućKUx7͋%+p6OKYܧbnƪޤ!Ogƈ E/]`( >4d[)XN[b@ 6ox#~^qU<]L!l&sZ>Vzfˁ&Z]|7ICִ9԰0#33ٟLdح>6ɻ_VC~ G?VBֶqKbܧvEiբ.I6MXHR3LMZ-i&6uK_k S7ĂR-3+Y"`-*T  Wf{J˜(I f!F36H\^CE'+f@'*D0y986*Z{Bn!v`1%LsP$0l|Jo/AKݤgIVavE%҈\i_9Ou}t0/Jf$A1;'ۗ k"@2 pRXc6nKW&Y[|;dw!cK=Ez'9*xΡ.V$9d%&:Io-?!Àf|eNduvᴥ[*i+a~UP+D32-'j!j&d+:Tcu ,\7 &&l./-' ą„Z㔳,9:R{-hxVW>^qNoO/,[|hD5*ڑPjc{0V<5F:E{!F%חΎ$bwG\!+϶X6C[#VלvdZ1fr}J3 eѤgDdI?K\>F(yǹmViVf׵m=Q~LKis8"6vʀ#D\DhCRA޺I{ $sv?J=3ݽ>qmo*Bvcl٦'vc]TTǤ HDWŪb~9id*('gKǂZ{CD*XZMfTb k!6LX]%vXI񗃝#D9[<6f,&g:ݴpyEYP KZxLW,O2etOQ^EUhS)3Hml2zwu9B%?u560$) is*4rR_Ul:?tmΟJ!l`=)USm{]b43w,sG/RG>1_y,%#9Wc ?:26sl{]o wfstEW _,r5U}R E"3 ,/5_h$|8zZ',O2uğ_r1bB8v G\sJ%걽j߱Q~ RvLB%tp',S~gb {vRV*UA@'W!Nm_x!ёxi@sK<_̂g5l|]񇲘5tmq_:ZE$O^ɯMcnMr هmv~% tLRRݦȭz I/r<5:yr8;]P0іϖ, SXuճ7CK6]Lϩ: 50/&ʥɏ z3BS郾BfxstR<ωd2e2Uq!8)-/;BneV=>kДF:F,& ?0H/Ox TBy1L`2hԏ~!]E轙17Cï痒b($ۥ D/J[O4ZeJYR#;4R0@%.HJWҢBK,$J*޴/מ]\kб_\AawGhc>flV̅˅d5eX QexT:3"uM2,:uV[ZUCns]Ԝ1pVC"6R})z*|RvGiZ̍mK c(X"}&`vlKw?*lbrX9S$^vʸ)so~}=I> 7-PծN À;ڛK:)ĈpG1fo8Ijxߚ#x;OI̪)niϰa.I2 cS&`w1tJҏ0,' .VtW)OYlՈx$PEĎݩoMKMƸx>X'<;}dZ3D :^L\Ͽ/%&@+3U94XHRlD-56(+oi[z*Jw$(PZTJN˰\C _ݰX N?6^ t:'^ޏ'O 'B{u)ȅu/SNEO+f#AɃwB3N^gC\QyӃ˹GnV׌%+x\D/2Zcrfj,p\|o"碭%MH6tq@D<䮧>^6s I5e/ q#i]f..G|8zS R=Lgɨ6iFm|w5!-:fE|CG(O_f-Ry 8aP;Ljjj r < p6mRu)~㣙J#Ga<|pO_fHȐmJZͮC6Yz9A''TܑTpFJY?im'DJq yVlajq(ǥv$r3%@RʛxŎaRIGD/%Q--B= #[\Q47a4 WE }KDq|h" ?ÁvHh;FaO/eʼ =.ΜSRuzAM-0۾+ZCdDUF ÅF@C#zdMkj Iuz٩+LUt{k=GHw>oMAV3y6 ChÜ֚4T_ li[ Х̑%.9_?pe6}%J逓 bXrgT-jSlLy.J pt#w$YhүC8n*,/<4hdM.31%o`U-kcPu-@BPS};vF^]L݄BEZW$ν\p߽D.Fn6E'!EZe ?2LQA)Tb$>\Kl|Qe闣|+XyMR8/A-:I/ocDulXuOh-*Tߵl3HԶ Is7%*2l+.ȮsC.pR Wt_zq-yF3֚[&;roK9XEg}A|_r @\paNs#G9ZE4J Iͽ/ ô("?<ε'#ؼHkZG0/ܦ<Q]39[`m Rg,{]J~q|? Mev_ ݱ`wQOj#MW<7z]? rkE$T~߫[ ׮AY`~:[t;q1ڻQsEa-m-ѯ"Ĩwבo[4JauefϢϓyyK +FҊ}：߅zRJεfu\>>E6+wlj&!3S"9^sJI:G+婘/{[OjUe4"X|ZK@H} <΄w9Ġk4%p!Gǘ""g4ӵ-&'YX~sd>hD24P!sPw?DX?Sȃ5,Uhd?xY߅zÙscD@t.PNX*&e/}93=/"nu I%t&L1j>H1_d8 x<)գe6w烸(@+Вo5o/Y%) ~/dj:{n:8I7Y$W GKMa'Ѝ=ydXA8sÇ+Jʕf& [RFbpjkbB]aiƨ}"U+}AV&sDr$n= ?휽5~ ?ght79|.uՃa{^̑pDWo$837CjǑ*!ҳ?rrĭ׸ס]ZbUNO<(PJĘ=qlf_{ ZsݳL[e{<$$ rYZ!{%# Bן;` }GɎ%&MugO=鵓ÔT\L;.dx~ Zۜ q/ǀŲ:09%|u 1A,;ݧ(lgXx$._V!wALM38΄G{*Ym0蟝ذfw=fwgiHk7z*+Q1>lq Q oWk['?_pUFBeupkJ2՜oRJ6v,_$۝t@E|!~ 䉱HCl?˃S$a$ч)x 30bWrCDXI$ĭ%hjB2x!ڂjh flR͓Ş^#pRb/@P# %`4-䧓ȝ%:6f }4RvMfzmo4 HC=v!2qKCs*g0}EES|6[v˯ $+5Zva]&[L>\ʌ/sxIPDPR}%!/',>_61o8{љ-kSr:vY(1G{en36pɇVzV D*cVZ)~ϠbvXCNڱ (JڑC h =-4 ˯MLy( עj;H@c&]HGCsg ֧eo5 Y!c^Tɚ:2/7"C?GLw58&D{0!ȱYr y<)`.>(a>~V/ǂka:TX^9ȑu3V/ U.g$1bsZQəu [\m~OMgAB6{xLEk|?S"Z2  Zv4dXCWa~ZX[G,'gN8eyAj0|ONYӆ"&Ҳ< O8ZrϚۋ#l=^-' !ŵB[odU $kCqfJ\<ʏ,*R)ܛb%nOti%SBTFQzVip$3O =Oo>8xD? 3{ҝtn4)b-_^X'"3Qi9EcZ@=b\k1CTˌdSΠS8" ٙ"~-k 2UWOL55|@'LOUQw&Obj4@wdt(hi_2El1&Me>/)H?{~K_p*V"h䲌.$buz9\田= !b]d8  ZC%6~&#FU{,{Nj%(l}'v!bP< hqp e7#A{"qmhR'5mY2~#cg ֦?Ui_KG'E0@c:Y,raXB7M{bザdj[n$MaX֏1_MQkUE5*~aH!:S<%v0h?qa_'~F[EnBbՍ~H4X< endstream endobj 299 0 obj << /Length1 2186 /Length2 16737 /Length3 0 /Length 18040 /Filter /FlateDecode >> stream xڌpk Ol۶mccۙ3mkbNb9Uϵtk~XI^(aoBW01201Y%%:9[C/4r|d\m̬ffN&&  xbFny\<LܜtmN&Fvy# lj&F6U{Kpqqadtwwg0ufw2[XT@'7)/#[`jڛ9K󇃫) q6@UZܿ . W KLLm<-f6@ /C#g#7#K#7H+>3_  Qdq;SQ{[[3_Y:M>w[lfigjSWFu;KGWؿ->Dd@;'7 zX0\/G @_K3 ,33` 4C 4輓31IcLl<\FUYe5ڿ W%"bgг3X9oscQ/  տׅ'(1@guؙL>?.f(/cp[KGkdkio|l^_SM࿖Xhjj.F!lgn"Z:KXzM,]L,5@GxK;_ >v*q**v& ;@`g 0wFѿDB\F"N& `XRG?#G?#1Q0jq`}`qM>|\E+?G1 >șf)-]A#?ٱ O[Ň#!m?#"}?\$l?2>^v6@?ac6JFJN.!qs0X8ѹ\TnloC#_G:}c9~@{`a>`- ]2y\J%=VB9d^fcԣuȿgc@@Ӡ^z ͢N$ưzl>{W8w`ݢMSx`-z\h+$EK[Gf8dɬTW6+/LWRmt'E6(4ZVk azFU L;`8!'}|]xYB, ֫4)蘦:{mLmߚ,PRĴ\a ɣL6c'"f|, U+!0[7:v;*I~$al~F]!H찟gdu;Б62p˳"8c8Qc|_tdbE>'k*[D)_ݨ)ȞNd q`حmwW}Qq:u7ԆXk@ B'u2~xQglZq=I)Gdo {u3G!#wJc3sqed^ f|49a C(!s(EgDr%+櫞k ]XӽyHf(2vua% {'G~[xv &BwqKں"UBYƯFaG5PT~u w-ݥ]eK"TPB(㿈|#yC&~hĿ@&N'bI`Ԏa(4 f#ɩ8(][Ad(YOnfOѯhy!'Mq䖖o)j\нntK$$J63Ev9G;ePЇVr@HXYMzJUk3gS%i` p%kovɃ667؅r^Y%%|;H̠#j.ZA4v v6I(F5mj=IGe/;6EK >I/~-ik<=*#^Ir1|]Cu"GLGI~M! qt •Z3T'8oekZf;(Qu%?B+fx*zV߯)Dkj誮z4tTMSmyDEt+n ]}DĴs :zE7Tg$ZvaAڃ b-rX-/+m&Köd>?1QN]5֟kx]9?~//p,hvU̝^vbM/\Q)(<8q[1@udtsKMZO)ɺa4\ևf V*s̿3=OtܺDizhe9:lҡ1Uy_cy"G1Eك$ЀG͢kemwGT7%&]v;LoL~ul3ݒf ^-+,;2p'ٔftw'.!L_kbY@G{*hA OB}P{#CjWԆ79-1:nS,G3gްyʗ EQ-Lo=Ypr =*#xp޲v Og@8V.ڄ^u iE{m(FH:`@#F^99S \ 8>ኡV1XȢ/3U-"gu.{ mD ,"7;.W@ WBQSMqEU3ŒAL=*YGRP, 5\jzc>.>ZE[4Vj>+Wztq1468@󸮁503qNYnO Ŀa:ggUr?u;ZpXU/- GৌF*>/} }Psc`)[YzE%^0?.7%揨bchlHs^RC ^.=8Q5xhm^*@"ƚ[VӞJ[2bk%1(L9Iy`b9UYr$!ަ)q䞲ӄFiRTuDh~^ʛ̑^V=jebk%3=*5jK'.T,!mfas>1#7ߛ]&0}zykȉOƻ~6 ]FjqB }yĝ0uF<\aĕ-RAUg 9* .TvH$e#HצּiQ(73T27u.P)F&' ܓMzT?: NH+.>q[ёfႤ6oW /j^a E$EUL% : ">̤U u ԥvԨi`*FbN1Z65|3l>O&yBsY!E&%R:Fc^ #j?ģ"xƩflzұvqD)J¶Е9b*F'v8=4;n),[E.@(M-8WXD:老.?1zfl@(4 EGѿ1z|Xg~#%B4*6{!Ce ] QJu`O F[b4E >&s. d:M0\FM܋iS\dCmKs.il!]; _ܐ; 9m* o`dIPl:`F.cf 3]dPRĿe[Azuf@q!tuE{Be+sv7DdU&B>DFm":sͷYan@%P{筗 kRP7Z# ilaT9Kطl| /@ gD,w5Hw"+pDttZn:bۼ8k9_Y?2`ǿ d0YÚbY d/t|E,H=Me(N]̗4!q?`Q`=IhoL0aɅCmƞp8MR=īPEMyQs5oRěg-TR gҟ&nbXrHe06Q-z=Oଂ=o/fUiϤR{(:%{ʤ928e ȎKZf#c0/%|O/GHJͦS2q=$,!m{82dYJ礫%>;ESE n >ef0|"a?)DW 郘py blc>"Lquc!؍l>oh6#eY SY+ٚJ> R:l,]j0q駺%쮇T=򥶵iCk8BklbvZK%Rι@Yjꮟn.Hx٪fd5߾qߋڳzf nNpbJXS[{ H]l R4$,.QL[Nx1`l,#Ğ.|i4(ض}jto^ơ_*h{Wo3Ԃ7%f_Kl 5ė:;H/\!FK6-QH,[ o ڙhmPi51rbՒ4B \Ԣ?W2og2;8H\bsVe䒲 iRsE;P05j.FEԽDǫ#N@Du!JNImL&HG&f3>o-iKzbk9W 1tw]OHBTV8(ɘA<9qѳIi4{Yq:< fsP,s @z{ւ z*.0n4ҔT):/1׵K!HhC(Jv ը?Qj~*mI6,ީȓ]˩V?vG۹ -$wQ(F,I;ob=@/xQDsOC*V Y,™{Au8*^f(GVIa"J|ջ3tH}ldjijU@zAǸ}>n? *}M|mbVGA!P `#:߇R@}&Jv cV*4s^c";vJd6Qs{-L JtJDrbz[ y'S2r* nnke9!Kw!!û8;= *P%{ ݣ/ зPl^wEWDO&_5z+zjX &QXZϼI;%D?םmF2Q9SY\Mܺ],X |ԡkSedp_wƲ50 lE՗~Pvy\Yb3GLhh_C8tekI,@ 44ZCQ#:퀕et|b C,/֦ʧlgVZ&6'Ϻt=_O`~N1 6W o}y~tkqpS#N@⨒V3'TSM f7'E6{=צ#Cii:*1kyqB* B2yJ[Zl;7$Nl;;[-$bku^9U)I-{W$ɻ佗J7F J7z-$'KʪIuO[=,,ee C*^3 ],~LzʟGCH)rA)N{S5tLLi9>acڿؑ,ن!HyWv'Nx'L> $ wMZUp*kS<,[ݷT]K~yli-XtpfV9s*9˶: /ҘUeqmu- |rӃjTi\PuӈU8j?$o}z3OljY Vecb]ծGG8a~F:aHYl63%^1hmۅfd՘)hɾT`W Ql2T/a7*CZD5FԹ ۟9}M{L`~7tLxvM YT`rba{*`t/3:b98 BnR7 ~7ts:0BU !,#e 8޾AlqT Ȕ'0 (ƎZ~ Vz79ԫnE&((C "e"5ȡ ߴ.T/s;U6"5V3JUqޟ@BD\s>{ĤZO7\&Ebol&u8>rf4kiՒvDIn8Ksz1{O=*\BIjY9^zSqtJeI;t*K%qSy=QdԲ) Cܦ-ݲASu \/.daG1;:*51O/iX~)q⏩~u#'-S1pWkY 0p\lIE,[Ŋ\| ] xZ-U(K014"5ؖ7fy e{8{?qhGX}E\J_-F(<:{Ag,@Nyyat8֊Ei1M|M]g^7#Y 9*jE$KMnИIxgj%`M"pYQ{&t3c.~%a>ZkI'('h-I@V2(/f+d"Ӆ:HEVOn(](lBqP}pY4S_dY\` ͉Pc7 Ӗdv}Ac-]ny[v1^+)nwBx$)%D5fJB 5P3Yilj%NjWsNصN c,9V̲KWB(tE`,Ӛ" D]fF!^ v:f<M#ID0,sh}DĤo89=]|B$uz²v䂯[*|7x!V5}en!'f~;tgT'olAM@mJW ^qnbeNKuϣ.ti%|vҦ}Ew\'Q!P5i{E^%[HTEd/CdPD*8vcz[b ``9'a)br$?u3pKw7L܎_dF%gTqoxHČVrVáG=3})6 R]PHGo#FcX IpJZhH%t7&B9Xc aycQx @zŻgs4-F!Y& ̓j<ւӛP6!pGuV S3ǀLj=L{(#=CBeRxKG#-'i$B gi$<㯍oeJYW^*SV,SJ,ë9ByTiS^2S۹J}Ku[=X$mdtN ,1?ب@ی~po"dF|JnI06ݰ Ibvk"' 3BmSPPF_/|y`^ GAX-$eIlOg/? :βׯ6 ]W_ GP~Kw6(!6d8ۅll -OJ&8 W"Gn{DZq򬇛KEy Ak WgQ8s1:X͕yqRU[lH+Ĕ(WNgQGt{p+xр̒aJ] gߋF:`Π<3XQTEb ׊V4)'-],69G*2K$1ևOz\&Q3n3[0IgI4$sCL4EZvUN,1m'?E,Z꼯[!B K^D2[;YyP~-Z1P'.]Fy;9 #k)я4[@.^ǩF_BY5\8-bջ,hSؿEϑ"CuŚk{)jƧXhZ tHP5ry\i 5 zT싄BoOӔdZ=טusAَr֓P#y ._[&x$Sݱ q? v;eYXZK0n=pw\#Z%W 6B9* s Ғ֫Ҩ!:ϰ: CdnQLN54ߴR, _VwU1f]Gy1q9L+ou^;؎47.+>ӑEYa{7ܓkLXjS 1#з#h\x/B9K4Ix@7Ej`?- 7X zgFF[B߻')|&P60C8@ez! Es/`GG.Eᔮr=ĆBT2Dnr)_Xoudr)+:ۤ F#:f??bKpWE|Zi4șw*- bʝ&)?ZN`7D p7Ưazйh^ZcDH]'SQ΂ YPVLK@]%bIJa6U֎dH]Rwޛ;O/g WuH20eπlpe `]ZX?RІ\g^5y5>qӯSoc=,2[}ZC+OюBfƶF]$*Auzv?>fPR,i

}^tHdQF˿ZG{XEC tHt'-Ns`8&g&-`'+dһ5m#)%m quIo I-+^S*zJ-̨TNEb(Ka9w ~Q99u~BbN>JX7ٕHQW tESMk)t%`ʩ\^s.x{nP9~(<@&՜uHY@?h/P^#Q,s ׈KgLtWM3EIF$$a$wZJ #5 Kr T`4\,Zr ]{[}[7ԉ+ȶ*skb^y銭֐3C_O7: %)a=x!+)_=ׂa%R{$1]ۑ|Z LYR3d{5<" eʅY T?[̳͠doewё 2T_ņg8Di"lM=yͩƻYȅ y2`mohNS/Q <__ƑI# :C~"D0P;>lћ4korr% ؤq"ޔW.u%mY#E=͇l [=fh盽` /To_cӈEˣ8y6pjWQ]ͧpjf^22֎cQ?6V-$gi 8,'i*\>n w>@#:wڦv d̟ljFN/s': 7tU~J39Ҙ\!GoUn*Wԗvl$W^2A6[i#? #*7d-txELbJ /ި_]ُzZoTS ^woNjPxYdL|U%ψ^,Y;Y}2/{22iO r O; ^OqQD'$ۤ ҕ1` ҡrOrg9˺3 +o yk\;s⇀Yo͓t&Z7 ZXzG#}vQ]!#51-(d~Հ3zj@tＤ,( BlbWEȤ{_4UӺLd-' T^*h5+w,̨ڜېb+Z5uymd*ʮ:fz/VAUn F >mp|տ@^C.h~MX44^^zt__=:= C%|[^p<$w@oP[>sӱkXk!߻̀amNABX͢@z%[{XFsGAmԦU5 ˲řߛPu pv rE_1Vوqk u瞶FO>3 3Li_7@XQ H`Lg aM"򠻌b%gLB+*iAFhAa S~( ["xK6>ȑJ<+95>\&ү.BBUHt f;i?@z}>(@ٰm +qI0r26ƌŎe8@43-(A L1V(m<܁d,gqIU Bt4Jg."Dn(!hf2?s/$'5"U>xQ^0&m&8Qg&Wx }%tTs3tn0r/" Kʊa oOJ|okKI\eOo^dM "٤mR (= 5Zzʤ—h; ,?c~Ku2:·3`δ1lUI@Im[_[. ȥ5v$[]R"*?=i@D|?(oV0ލ&P+f4;kj4b*"M|4P&cA0NĪ+l/,z2AۓN=zf4wr.f"㸬 ХdKy"5>E9[y607;푑g01{;}it~DXyl^'람/.=c}p /ɟNG*$NeJHTXgxNG 9K1inm+%|_ӕ!~-JD~R is^u#+H؛ 3Y7qW~ i_t̸ }6*R ApjdԚ3F #42)IIlW6c_^~ g(q>]̝ϋi=2F`Ay|@kTsfpw/B`& ȫEeFR˙5s;+~\icErcf5l $HYuJlcdOoͬ p gkVT=ݹDޱh>(hNnN5jq`_6ۜu5ti~4RK`ws91کBή/nUz=\]en/V<]7Կ[݃A^̲VUcI }-z0oꒀ& 0:RWؖfdž3Du^·|bmfI2Ay ^BkMc-Om! ?A;QZ۩gq VfCzXׅ3Ddt䂟T g۞JC0o7vopڸ?yޓӲo\[…R gtG{HVeqa23Eo&dͤt(YUқbYyxlӔ3+0hmg8hmF0yտw,ϩ8E (?M+a06`tq,ЀG+ړ򘝏Z%N[1EpknpJ#׋3o2{ė=훇; E8}@2#;;.yA:/ zQ!.A9 ibfnُ T::ЌY(l6J O*d,l@{,ٜ.g)EVMy-Ck,K9ST4gfdSᒝDAH/`6P{1NK c 5'd qt?Zш ۴cplS׿DPnIJ*LʉAV_ٱY1GueYJv) +diDtFBM+P)@44y+q*wBQoYJ~3=lPlrb[]`./Tgd-v|@|P1.߿;*Hul=fm(ߣ-FW@;t4H>փ 1_@!Wn`:u%mFM0!q4'yẇMPܱǠʥz\5zQE{2yZ#uAR<8>CSgh3CO[.Y8;' K5Z\~> 2jPNhHs.wYfRL#tJߎ!܂mZ(ԳuZȸ 5$U a'.)]TT WRM,׹>JVցJ+ .Qy!9{v\ڥ9Et|J=  Sޘ?dTӒt_?URH_D5,~7(v݋0YtGˤAyD^spFLGV ߷ǶT)=Qa(|ͣĕ;ɸ]Jǧ>iy-l%bo*:o qQ"ɟ~N&D@R_XKDgQ\ijD.#!!,ED endstream endobj 301 0 obj << /Length1 2021 /Length2 10297 /Length3 0 /Length 11511 /Filter /FlateDecode >> stream xڍT6LKH H3twtJt 0 0Ct4HHwH!%tK#7s{[<;ww 4:6+ Ȫ8y1tA0'?4&> EpuZ% Tܝ<|AQ!Qnn/7!n9K @ o7= ~>Y<""Bn kK0@fthmЁX0J,nrqyzzrZ:C9!nv,O <6_qb2tAпy- N k  p:.@v`'Ͽ+b  ' @C9' rtB 'K+_[pȃZ\`PN(D_i]B`W}r 75\߬# ؂6DظpA@e\opss s=ׯ.p.-\d Zz07wF<<5 `1g@ۿ1@^cn>^6oKF^WNSodd ^_A7[ $46?b5-A;2[yX02,>Ae p p[?/_!s+m w'?fKg?QvB _^e5 0KzHm#h`n jB_ lv?(P]e鿏[Cl~- ~p$o pq!0x.` quaE\ K7pF.0/K7F.9Gzt=eҝ5M) ߿!s‘?tsmٍ GmҢĵ0F1fJ6 ۮ*n8J.haqҹH1F4ka#x7 w]e{PL[,q|`tOH }ThrGH^e@e.e#+bPL_f; &^!PuznD/R;Pؽ2s7rAJsMkiB՝l8bWax:.j9} Nʄ>,حXRl!ǃ'U_; :i}YB]g/o9R䡶P}') K5( TDk;5 BUSm7QV>Nͭ0}.c0B#- ^{@K+=PU9ŘκP$zQ,Nrي6CO:U*S`n!? Y ǢȽJ#C%0=IdfkkԷ e{0;l ~k:_vR%=|v~'1Ҏb}r#߱е+0T9"*aϷth R0@Ñl S–"eóX~\0%ޓ9{:A@z"SdWR栦=|}C]nҘ}>M#LSiK:kR9 `fo&rIz볐[E|ʢ@HJȏAyPƖ dļ^L\OlVAKhn[UݗIa$oBkr`^t2*䑬PԖ$WLY=u_sU,~|t2{ 4 =aj9X8|i{lyy{ރu.Z-wRe7P4ˢmGRbf"HSZsEFUoCӕh͹w =pgdfu@'D vbJkrf  ܡB?T]zȘͨ뒲 TWVQ;wmN5lEUG]$PŔ'hq@ f:ve)kv5 nNzP ^dWU.ˎ滝eokĿ=Vs9˔s2$~^9VcHWDC4.rt #O::Zᛓ}PZ Y=ZXc8F$)oߔI[J?T'{>kw:6x&hLқ'qoe+EN\%nĸ8.B85Q8i3 vwUY'MQZ~"?2Qf~'p 3b(tOiv8%EO/lGK{52Ō}AE?\0NlV_RdytY W^SP"5cSC.bn|/*soocUtIo{%Ib5pE~L)}.v&d3P) /3YVc-L M7Fl30i!EgS+䒭 c!]1mg,=G%TIc2Zɇk~6aMVbƈ'3J-q;;H> M8קKeHUlLSZD.='ݗ98bV>Ο C2ᰰd>8iiDA(@V,[.Dj&_"4[rTңw؟DAU>AhKȼ]z?l!#$tU"mj|>WZ2fיi54`E06RND%eꦬK_ޞxk^rU1Aq"A䚾;܈2fd8JwWJm:!ș+Itl DԇodH{GRl \,5NE;W.i"Xa$ P-~4lՁ0)L+c:fj4k<eiyX^Q5F[pN]4X 8O-=fĸQm]KTá bߖ$4Ex%tk^_D3ˉ3p&c20rjdv!P_|4yl<rzPWdn}S(b5&LW;nܷJdxU+le@ 2!q}-/&rq _(K2?g!Mgzůo<~tR}}5O%6}*02!́=}/Ȃ(rexC@vӕ7&jR#\E"0,߬G|zӂ'츖~򹥨 1WMzNVO$oN-=#̸D#;Mv~JZв|˵4ct><)#i:j&ua ge׈Qccj .>WG1>94!LeUeuܠ1K1b4RjBRm[Iͥh}H8V&P*R<߉[&Ǯd}ߥt`Q{έG'\=Ű#CL.j-"x-҆cIB`z*=:51 "}5GYV7)|iXRQW9 +#kyTOj[HͧE{SWW=$?+}#Jl[vݦ|PɞӣˈiS_H(c:m=vb{](ｔ^$' 8I< -I温zKtJ0kG\`#Dujmj7j|ҦTv)"2UY[ƒz0^U ͒=2&&Z`@, Mjl4QsJ'7g.ڰq ҧeXFPDY&Wi*^ez j{C=wHu_Yj Cz' g&6:7 [J5q.‹:N@C Fv% ]{NWd|=+ϼVT%{GZ"nLkmOte+|z]r$ȍV .O,rَ"yvjΐ7>JYxn/4_<T??2Pwd7%c#P> 5N=[(;3}e3 Eռ : ai1+:9}*ffN(UdSЙ>sjcF/g!td̻QKBuwߪ~xBu5Mа!6iz=+#nTx~X5]H3(z!_︟}A-ٽm!{Ȉ}.۵ubGkϵܝ#X^I!5oBa?}L D^>6%%l10K]?V/y1#Uz:'ƨ9->3 zE%>c'aoY; σ1-r7ֱ}aT!;l myjXɏ 5J+c1!Ӭy*}}ZjI3f@pxdh /6~< OVQ$HC鳀ɓ(4l,nss ;'l/KEx%#㡱]j2)ӯS=5uze&TYGƚM>_J} 8%'?Ub)=.S66B塓}U$Zf2ƥׁ* dHlaiw׏QV :]>^&=\F38ơ&ŃwdJy[F\>f{SJ<( O,SvS*VkDŽ&lroySHol }g*/ݣ]-{-e(?S ~WǛf/ۓNǡmUUaDe|f._x$umAFe-@Si`z-*-.ɾi,(`]{:g q ANNem_6О c9@t4a-H밯=߮5}ui0au/%U -)kLUdY—^y 98ٌ@ GZ"8YsTg'NO4H?Xkf"V!O7yN NKҾO4/}cPT~s&l-ᥟbpP#>^z;`;4b rtS3ϔɻ]Oo]GJxR7Epk%Eӝ%okq TϽRt8޶qj5DkM7)6' ޱo%@w$Qtj %1u Z4[9t2*Z{k4㒽;WCnn]r gT?jmwWqa3í͊-&2OU;#^jw+C|I`@ZX8ug?P桱5ݖlh$e wH-:b\rHǾs8Lm3 F D"&wⅻTv 8\0$nbp(wxejZ_g2HX"+l]Qa%C`>'UySibP*u Ǿaɛ:ȊO+!(ڢE/Sѷa1x%ceoUFWp2›Q "iaVଚ;t4W,]{Eh1Ii,?>nZa:(g)JtO*кD׍`\jCӱ_LNbYSQ׏)ԲHX;89#uJ| N'!vWK{5:n+#f('L K'VqZBZ`\/Q~FpeNJ6ox|wEGw,>"&N> ~AȪ`csD2VLIy2s^VYҰ-BgU"S]6t`>їQzm,yҡk`c]qJM)ۛcE#L ANl+4bL§Ѓ6pr=~,3@DHRMg{u$N]@rF/ԭ8x&ށMEz;7LJLJzMM;bU E޴aWOcZOfIEUL&?WU=:I)y$4Vȉdڝ2K98_{grL䌜@S7t ncr^t㱜J}qSw3ѬDx1P7uZ".Ż/[52QCJbR$\-POS1HDJb9ZEf= !s4cXfT0-_cUYaZpWdžoђ C{%d:Nh@GSeVtCĖ"gc,'ah}#k:i1.51mD1^\)i13"\nc"*]b]?ތ4vT*SF%ҏY!!rm%/Wf2Z).ꋥvԓNd-E[ގMM-{\2 e>&pꯋ]5)e UZ~sUDW䙄ii·4m/>/f+( iȐ23tH1s2>B[ziq$k 􄈥4%-]!K8O-׹YQּ1T aZw9;-HkSCƻQC7 ܢob0n}wؗN.'DD(j(.G0!e(IB %#&¸i=*lv$^q}!`zl1XRWqyA*BvO{][ k< 3c@W9F8(EsK/Zkx|Om2壯E(O,W[y[Q{@{8"F{)gr]1droHqqCec:,C~\Ե4-cb%H= +\vVۀ<0D$1mhB&W>K*]eb2H@Ae4UJofsN?Mf&/Y+=,HCb($"x(f0|ݢ* bQ }EVtȉ5^vhV\+M}xQh7:x*6/%ƥeSk3Uđ8Hlқe¸(wѤ%_ae-~;N:@ob,Q;J^[yKR`ƧGk!7_'q0WYPYq g 2?izsrXgLsya endstream endobj 303 0 obj << /Length1 1439 /Length2 6418 /Length3 0 /Length 7377 /Filter /FlateDecode >> stream xڍTuX%t!ғ.0b1rҢtwJJ(H#ݒ"! %)}{=a-k)"hn0H HCOO @< UvPnp$B?0P0'A_C5 @ $C<6@ *s>BxvN١@0t3 B@ | q!p_%%h1^^OOOe'큺07fE qM ԷCڢ=!(nI xr!y<@0rf*GN@Hg`@-Eu ABܐ b} =<(\swA~U60 k>y8 >yo޿D`m_Tl]x pWwk @" ! jr_Ÿ ]T`p[(w/?`0Eavpn^@3_,pyuT8&wXNp | $* }]3o6|QQaA~);h"dG Aw_U2ݝ~#/'z*@^kP#C:wL ֊,)½`6p4U&;0m +v>~`wKiK|B@ \_%Āj@^}& EnUH+jm ^[PhV8Vth֔s=ɜYa8fT\c:9c 1Jc+Bubiӿ i-mcשJ}*+EaՐFͦWwD E_<ǖeRyxf*D) 5BWo,i}U]P4x7k\"T2̦Mgt\/-4ݚV[1ܘvŶs\dbI=?cۙ6u!ܩR]fx]Ci8+{=Wx͡>\ҏ#p)2*"L"̐(0S! ُ#y_I*z-n~g,X.HTK9HTw}+3?=`=k@&lQՑN9XГv78\;kQ `]k(v_wmtc==o8_sԚ+Q1N/{v+m0~Qbƨ4m|=Ε5=q#?}cy_]S7x_H*\'[E^VJM!.g?vI1g(й K}sW]jRȣh3y%m}n(+ܨJ|X`sV|j`JJWp+:~˟? ^Q<#]$ᒜV`ļeC[(r2p(t4w ^,+`"M ?=.sol' $

~Z A軘oFc)H'r r+79 7ވ0xaؼ\J!1)e  . JT8kOUjCBfKLze>$bԇ,4QqQnPO$tȗV؉L*OӞVDuHbꯔŊd'#ÙL\̳L}YCn+.^CiP#n^hie}lEs$`F7sMٛ%̳>dVVs! {"R46U,}-j&8Is[8zMiVu}ܨpHzT ߇B$HB-_lT )E.iؾbw+RfǤ}RYL[ mwS en)Sr?@Hgom[iuOvHFsc}Sw@~T/.1:XsV(8Ɔ h3<-翚6HGeKhGڗR)Z{WŻ>wyU/.$gt Fk>MC@8<5KPqlÌ-\2rYS|x۩By·U4Dm_ocaC݂0/`*z3yJVK"s+'"S(?a *+kx:Qv +>|ͅhT^ŞnYp$P|tצO2IUvo%@|Y*a2T²s19h鋔Aܯ7 ]R4= O[wσYiҜ M.+G Kަ`O $4eUt0o2T8Ӽ6 Rv5xXlQPk6Xݶb1oFqR/LҒT?A'g>X80bF$gE4+KV; 1Y*{vVMK->4ebsE~qAzif2]V)5"{uUuuճϭkȃXX xBwE/Xz`UcHD¶Lp"ӫrh.evQ.n'hT{lpjEY8yG} Qk{V~\Rx$}Zgzx?Ђv~Ϭ=lu3(ǘ>x*4uY5#b a؁w=8l4pXރ3$q̷ =*7Z89mWM%7ي]~;u}3-[йO5yD}PS!)~%5P(.,'7BIiZJe]~5GFGӍ?,l]})Y؟clp`*BWpXbG/)\(6v.vjjlt`gCf ZlJ<ƣǥ&ɩ7~Pixt̬t<2 G|cg,[ 0bF~s!6hIf[3V)6ߏ&ySTf=c/9LN0dcLm)Sfx})ө[NLXK9xp?+PvgVGk"?;Yc)nGf[oE´YӼ[ģq*GoB2̳QF<4>!<򛁟zr;륰z6)=giGvpí?ip/vyj{}%5]VB {C@>?"mnO]97!O\y:nw۹}џy=:bVo~Z~XQ铿o5ͦy=Z{]IJ;ϔ +2'_z^Qňn^,dG E6I1cB]CFYU :?7I!q,_60rk^=Y:3E)󐋹>Q48~ﷶiy =4{*P AݵU88,)?ݴ`2ޑUTRd_8Buh[xZ33M:\ϜŌI\QnS*3ͻT|$?IC2>M&MyJ ]g2Yf?3$2LUS|Ð!0!߳4ߌU;r+ssy~S2b)uV`̳G=112/e`1(IL9r^VcIKnb,벃~ab4gj-[̛`asGbTi_]lbRB8<.]4}j̕Sb]cxy$` 桘bkU +,L4u*?4Ue|+ּӮ'ظg򞥵X♺1;h9ЙmF'z{^x*wEDg>蝠RnE7j<y-u6{h>Aa􋚙/d<8HZ\v/ع.k\Fl5W/jĤ&(oNDƬK=Yr){US~N<3}6|N9]x11ŗ{ģF oQ2-Mt*6=>C#N|SWB*Upq`ʫE:m]o[{"6T/ >R}:toƝ:F~(6 rC\kC z͢I~ p thN8qjf ̻mfG2ɻDAo? l7w,lDCʫFOk ߨ2}fed'MtOppJ/KᰜD7FbJ,tZY&OnZQNM)||pDmXWoq{`nY;-{'#>Z;1)(Y4jpr7 3ޔ恸fA[g{ǡ.Z:hlv9rfVfy)!c9p,voL> stream xڍx4ֶ Zhчu{NDc0D{ !: G'JM=5k={_{p (!mHZ$(i PD&0пD&Pw ;ؔh P<@"H\ Re'-xD@QDJHWw#S[7Pp `@v`*Bp!}#*%$%vA "dy^0#{B(t.?8F0_C= ` p@aB<vPw:PC E Ht%!~!+C8ap(@WUKv`8 {ap-{`>a sEQ0/B`ڬSB@hѯ)ܡL}3{eCa*dy@5`0&h(PRLLG_|\~HW=4f|P@  B`gǘ1X1>(TL PSQ H H .. guoz`؟GF =  L&GƆ :HP\@!,{Gpo?_v} 0z@cfCCM 6^ 43# @P0o qKK!Q_L_>A1~g]ikE`wwF(U;oH4&G:X(@#1vxc0^u( !ABÜ^(0x l୬vF'E9g9jgM)ؽ37W11|Qwnrz>Ko]P`qI0&NqDfckb:s.#rPr(9%gMg@)ub?1ge_E?"naakhimn_Qfo؋J:*ytIPXJilt.86? ےD<to>~QY>b1.Dr99ڑ&]t(ZߋK \֞Bka/4?snLK ||(gv7]auZ/yҌ%qmPO! dpYG& &*bZYd5OB^TA~^[Cyɹq#Y#mLBsp)rRJ/L/= iI>^?@^~KMD[C!a+·6:\a'gZS=~o#IAB]CxtjdwL3_vpm{7\RI +D[-Z'=O,ΤmZ}j9pQᦨ M5.)B;S8$PmxC BѾh.@Sk9BqQ/ 8DU⇧ȇBfbo}]_n[1(hE[)=h(4O~Whru%n-rEK9R=͏D=IG5A߆$9?0aa2VI=*jI> gQyEmzɬgX_$DPRMi? Rpc.G}yahPeYAVY;8Ϫq+ԫwPFOJgu9!}r\?o"epc o*ItBYϋ5:$JCT&ȺEּdTZa륕*7eN4PJ+Wv$#%pMgkV8׳®Ϧ,Tu憜zHd 32Ө-Aч1n/N(h1ܬš[ rWËIlƥr'ur)3a➤2z TY|NաHZf}kG$2E' (>5ANF\tl_㇓~YYki;3P\J>k5/^[B%Rjn\t[74.91$}/!U,n9c%'pñX`;h4b5y|dI!OKhBpu %Ydm cV}[ 0d+NvaeM z%(CXX2Z'xP;>qVNi)7"5?(?1FzuE .O} ):p@}|j]) ج2Yg[|'?ES2Œu<{K >L4X껞v'2wK=Lտ9,LCOӠ*M<8HqKYV-)ɱqCX?զ }bjjx3rwSWUf@K#[a,!>.ع./jJ> 7!汫brԋ߷j~89n71Ii+ϹADi.F@x$wvmX6XDf'TkFKjYǴOu韝{W Ǭ8ȁ W{.amXd.ȩ{7[_k@ Oڏ:wA@B礱*w3"!,*d:G>GbMty/#xxH"OKa)5dEI"8tgX$s*8xĒjO&~1~i_<>>*[G,4qr%-B}S;f~seBЗB%*[tS.T3oԝZ̊ {D>7qFY-b U>$յZ[r灻(Bqb^2aL[@{Ȳ=Hud2'8Iɏ I3[ɻlكh;!حiTެEGaeW%RO?4 ~Z6J]$l~8fM/8r_:6GT_*[k)s|f /B S(`xηiꆌ9F@Be -tAjk ؑT/tc˃Hd|MZzdH>.Ef쇒*4N2DO,yݬ&9+V0Uwb֧=۫nXV^/Oka,Jzg=a1a_zMgEIKݞ6jўtz_3 zTFaSu$+RS"sE=+  A\.{YƟ%]Y;Kmp̔%+ydYq,b&Wn^y?HF;;sIQ._XtҎg"u;"rt a#n9hBix:ì{̚Q}zʷ(csR\S6~M}̀o׏<#rSI9HH ^͔m{*BUEK8'f-zB m)t\"(IXŢclsqayY5W/L%4d=K_,Jh!Q"䑲Yw迦O%Tku6b%,b]Z EJ6O]lGI;<'ҕskr;co$׎^t;(<"h["WH] iEt:Z=K&Ij}7śuР<ɚ{81%]Wv*wO{*j,rk,ו/NYL.i ~D"d>{mJ=s6O(oi<AG6V^8UDo|I!Ҋqǎ7M]3w^r#_= _w_Ub}#rȾc魖bw±\' LN }plHlプ:0B*\WtEo#̫zf9$^[ڕM=dV0Y ?4C!RL2 1Zt+%!.T ߳b, F<˃(v Z1SJ%^O!{ZN?㡏5+#;|ݺsj\b^GbfȻ5u#s,KL{,vƂTf"S"XflIL{iԼ|1 _{s"g,y ZtͰ3Pس Kc*u!{T#wbzAB/𾏢x9;|y4GX=#[lg\_YeE~h{۟[ML3%פR;s!LnPSO.K~xZU[^l:DxBFIC%2`Hjx^xYv56KߴYշ{?Z!NJs˕ssc {;2Sd՟=WE iƤ ]Z%u)r:Uzj턜7:83-nN|UNѓg\hԗ`;Hr0q/h,ӇZ=w^G9XpG+fvPh5b-hk ~jɗa˂ifAgќyK"'krTUGO(νʨPꥪ޷GKI:$g̬WxҒe` Y%WDS8pHG1R&v#SYSSĘG&5 _+,/w1r^+/_=}b+Ք6_:Q8U9dS'8vd`'=b7eTo F?liG:Vt?V^.}|>V6L+Vi> stream xڍP . . 0`kKp 5Hp'X^ޚwu~O 9P a`eHh+pٹX9QhhA{(4@W#X_ )&my%8n.  ;;]?DGA; Pt]Qh\@6:y[08 H8]@f`ZhB' $jb- Al@W;doi(4m_-G+ jY!n`K :@KAEV pMw@?,,^ 5 d*BNNW@?|_Y@@kf_. O;Y:b6U]%Y %)) ap888|~'Z@ݿ2*x=q{2^VPu|g 7bax?}#Y7{?f {y  _VZWb#`9gfery-A f?xa]A;Qzvwkt_7ʀ--XAN^"Z=q+xrtA6?L!>;MSN?'MHizelE<> GWp_5տ 7_|Mg/Z1l*l_ r|=5ȿ`׺@B^霅犽?ϛZ,;ZֆVKzNprG^"iI ]pG-Ht9,yi'`3YM$Xo2f?rUvih&8ia dv>۝<m9AkŊ3Hυ.^)Y#13ۡ@z.>;]Z('R34h3I2P4uDt 0C#C>-똖PԹNul ' d/t[&B%-Iڅ\qbOo4Ǿy34weJ'3XdbUFK'/v u^̭dt? jb;?Ysj\Eъ|f|$]l·YJ%|R/ei34#:ƎSߌxB}r$Xx8s$zѮ1GpϋJdg!B~3r><0>*i{ڛIWEIb}o7LPm** ~Xoӈx{ꍷWT*S{RVXщK64'KLgK`4xkL(4CjInTOJ&jz9 _Ϛ7DZ r='ި69 1hI|䝐%+As$.';wK@rl닾A׃EF4I=`<7uk Vzmr;cC.N+lx] i-@}ϦO6ru4{)6ǭ/ ||86T9ITiړ48e)h2M'e? ?ӞirUFl6`y:*,_T?ݗ>Tk)M|S QSAkR =3DF7Bhi3L-//\@T , K"P |JKz>T#//`V gt(2v,ӅwaG }Ϻ"h:c;1x[pJ@=߄ln9fQD3x%"M~y5V<; G]/'ft+L8,e ׻4 %9jWBXYk9Tt қGg¼bԦ#>QgMA7` |?Pkg<]Ah$ Fr'R풄ڤ}bg9*]+hkc2T˃4lGmD@"VʢVE{|{ @U(Lc Zzf2c+l@ѻY3{[~`͔VӲc4)"5HفQu .rI߼5s.6Yf eēQ~kT?ӳZo6WX^n0.mSk{uNU3_Gj7cz%"|V1~uQ><CiK HS3l y tߨi8|g^8Os%KSHKl̛Xe|Ekd)n:Byh9Ύښ &;U4'ƺ&<[.mE&^6+'ޔy~oF]B?y5dLĢ7'-͙9Y~FZFPlV)<% xO#[dG*WF=ܼf%#"7b$}ƴ?$f3-ԇtX?g|D}z 9젨GshT3{\O0 SA=1l2{{GMu#,H*i ӣtr||v4t(Yvy| G5jB4nhE+ApN|:1%(֋oNn)6E|J5~n >%w"/Îqu' HI+WG~vJT'0yq齱YNcw!y" 3nze ۗ\bHܨXŴrvכ>YȾŚ-w0OXxR6<^GeCZ#jChbbQ)s[`ڹػMC9^R'JKF?C^]#sϴ 5@=$헀v%wR0fpĊ21n*k:XQpO!=; Vjcrm͕t=/yn8k/6.k2k y>ߔ9.j) < %Xx^ɛΙR&_sacLFm/ʙdA^G&0" `7",9zpC{f4d+qRݣ ºA<i|c?0D[poe^VLT1uV(^ '] o}Ѽ.WѤ}:*PZӄjp?d(iq( 4xu~Gҗ4\J`\?:Ԋ4Vx@jI]5.'ؙ(c9$I73bA _B.KNo b\Rfga#=si3k!+|{89Wui34G&Vw-*H!nOT,0gHĎJ_7qZX<e+C[$+X;3yhdR.p1r/aڲ4(JB)5ӀJtQXOwyh*WiBU7 ~/\ylq]LpKVAץkQ WI7qӵlLS V!>6h2y߁3|ɪr $u)U gS?W1֋=.B*TB i>`P^Y~B5HQ3@.3JGa[||t"nIթ[_"NXX6Bz3 SIhKywωSyFZ^.D#U CWbljU>n̢QBቔ|qct<IYiD&P;آ3}KRk0 $ڏ0U8?+ؐ&;9g\oj%q{KyOۉV[i%AlUAjn,k&}lXuOQzi6g{*M)nT4p„)|%zV| ܀md.MBg P+a#m+|Հpوٓ`Ica4֭ izI H$Wl򭺼gO@LX>*ʻ 0 r"Q,՟g{o$)]L_EX%gxQ+ : mғ%%H5(?ګSh!Ҵ.)aya>.mEmőꪑ \UVuռ?V8E>M|1S$[jݒ*:hm]űUiںB;ߝ9n() /{k6QtKtAD/ G_hiP0?Cߛ6aotlI27$_M?@ I)ǾK,ΞД,[(be:F/^|:8 L2m OQ{OZhvwxxN1`* ݜߥXLZULLcǠ;~Hv뎒j BXOj_*?拸RJPpNB/3Au]|h\$SVDPx 2ņ=vt50ْ*F2FG2 8Ut:%NHF\?{/ゅlD?-d1T~j]Pp~h>Ze)ؘxv^.ԷJǻLC`񗷆l<JA(YXΝke"ijxi2Z7 'Л~oSS4R|ˌMhlЃ5R b)bx!;fu((.VwE_nQQɖZL:"a|I3М$8NiaJk^zvmNGJPU_gGÍ0@}v𐭨;nrjƀ @MP$?ѹ*~~GV A@NB/DP@IbG1x>HN_Jԯd db;*[&:q7RI(|5[_$m2f!O(‡>`Zas)eְPS0#kVGrӌg x* ϡ[O폌¬ J|&KYS? ۨpsl$F9eLg0@y7[5KMa5J?`NG+ /<:r|谲7B$=UVҠ=ˡc+03U0cpn EQ~:Od+'Zth_i cgڣ@u=1YS<3šϗ2&lh6hӧ V֚L^;s\r_z^w'+ n[@W$WC"CJ wu8bȍ4H@Y*+S\OaR7:pХm;/Ì KjD^A&''3LjPS5ch_o&ܗndy۩Wk+F^ΏoHrOʆ5Bnja SzZtrbJ~!կsP,IuM_?kCSbY⡨(XB9=]XK&7M`xXSG x`A:DGOdD Kǫ;A , 9jYə/jƨndo"RXr[ܜ_0Cgl[(1Q%Hْ܂ud2\VZPDp5+[ŸK8 9,.3iV4^ı} Ł};բX sPF %O5̵Z_eۈؑ($r$:UWj_ɶ*G(A r#@^v=*>{!>T$CgE` fYKP rves9'nNA+*-`g:~ĵfrOiWy^I!&:!K5g~C{:ir9k|e 8t=\,H-s朆UaC1:r!~q>&\#!bZC<<(cb7+ɉdhNݿ'@E2het}?o3sȰ>mAq~l͇BZ Xz\SƳҋTS.FeX1Ūpd[c kc\ t $T@^5`h \ydm 9 I! (!eDP/sCU6}ŖOV"Du3c]c^o,,IP}BľŠ{~i1&$9r$_Q E;/%qv: P4eȺr0:74_qBs3 ~)Swye/kx5[C♇XknGmS)|tG6GDNJ jDwEhGf8b"vPh}â>~V ?4vi(OF&~Q CurTYO|ݪZ*=˝<s}.: Bf4IW[F\k9J?[$R1ĥk| 3=v I, ګf3;>CO PL%&M=p#0nQh^ 7j{t+=_lUת65ԯ[N8y9qߤ [Ϝ],9$yV4;>OuZyWux?^2>W `QBP?Ao3t~_¦l =/ 1ۄTJl̉CB"BD*סsqah sˌUp[r2cQj$b>aQdIM1xMꫭ3LΡX-Ygfۚ_dyaJ3+QqOhx sR&(Ɠ}֓'gD>1 F/n*3}A]x[n.xv%wA@Iveq+-ɀjfҙnGp+ ǀ$#|kJxt'*S ŵ?~"ÆVCÐ XOR'$%_5oLnCmW g/ )TKW8oi׳SYz͒٭KY7RE HR29)iE3ؒ  R4$Tuw[7N@>ZvXsFVS@3Fv(dEKC:k>ҧ1ySSS8JDԇt!ݠ>͗ٙҝ9e(ЏUbaM( \ĺo'G<t!#."+5-::̦];I<N!}. '9h ||;IUŪ6Yևݶ2O ?)[o;#)ds(LXA4jv)7["cۡ3#cvu[js KJ~i R4~Eoɴ Vhs2W%\SI1 UV;U"N^'p>|,Y`F՚HH6%}ՙ[@\46%7d-r8ghZ.%R#_-eޞ@& >ꢛ|0MQm(*eqk=nQp+&+otD_$ `i89g.j_F/+&Es)2^nKr5癸FZq4hدBz(k'&uK&>Ʈ7:ǯB}3EқۇvbdomNpäP"m͓ 6 >}٫u⣍wr݆1 uN?hꎛ|N{xpe6>’M3:0*Q>krXv*z:ڴRVwVJ$F$X~YWm7QuMAMPħS1b Sp-1TՑuqbxA|JºrNcNN\@$O:О%}"W(ͩ/ey$.xx?9}v^2`j\ӗzdJ7Die@RsRWg~#>[(=MInU {Fwv w4>;AF+O? ߾O+99V>31L(ck% cVrMnaظ3u梡0Wb;t;}jJvl vLS@D53}pҳ>y͑YFtqZ%IY+.xMm\g2՛]ҎqR?ȋ{>>d;z1 VwX.)8ilMC(ھum?l?["q׬aT8\~BFPe&ȚM4e3[}qڳ~pJJ_~93\xDS{Q("1_O2HT=.Wm2V7-f+{ ZeaΒBR3#1GɼfCz;,Z$a`[k(C.97S3~;)^4>Ɉ cP/Oj`L5P: ,`*t @z*I9DA@o}M71 _ SF X O*}xwP-cH1Q^7ܦ\ޟ4{7HD}?C?ub1 G9(i)(IQ=eS{mOk5oSz NYū4|'9tGn-/Oi6ᶁv#Zri o~} _b b3MLɼNu _}nY.3N@.NR@Rxqn^ޣZvhVD $,~鋐%9:W;@盼F\kShIU|ցqd(tl 2\XchkB%_ # ,¸cB)Q>eӜ*d8=09fFhdďBx@BޫrYz1}UҗȻ)CiLp UoIN ^gC={/J Iz0Wϼ\X$SR)b[y [~*zc;Q!?1 ?D2u(]r0fY=7.lʧOH`3|Hͦس,'9Rq=ZSs= VMn`u |N dR `gxƇ2%'uY6^ LO(t"ndĹ#o5ѧ:ҚF,cW520Y?K]=(TӰJ]3\wߐk0Yjf?gf21P1~Ecei ӭqr22F>Si\o󖖶uDb)3 Q@cJ\ݮ6UrUĽU`>kXѼ5RI:7(QGqҙbsTh5d.6dTGTx<%BM *Df)⇨_LAO&%&5bLSb#RcN=,u+s8mXql7?Y^}{!Mc/+?)>ڼٹJ^֧ endstream endobj 309 0 obj << /Length1 1480 /Length2 7112 /Length3 0 /Length 8104 /Filter /FlateDecode >> stream xڍtT[۶4" 3J3tJ C%4H4t7JIH(""Z߷fgu׾{s +#`jHF$(o@q Pqi&6p$B(smS`t+$Iɂe@(W % Px:"M$&VFNmZt B v# 0DB0J;a0"7x_ 8 `h fEp7 ntxCP0!{ p9 u!#@@"3W!8w2 ECp# i`|0BW ·xA'kCCQpw Z wEQW[VE+#` T(}E 8H{#0ʟ!&m0 @<0FN/5@w;,#GC` OǿC1;#Awk3||x=յW߿WXYKS_))!}a1I . oW#?8\__<ߟ#Z%P;_U7<]]~7 g=1ce=` z<I%jpuCHzW8D8Y@r響"MBA|$17@T\9(_m2F $@7@@(uEJD1 D0 Jn w o?Vd^ ?>&4]UeZU??/|2='-&3ZR@Ywxv)o=žhuuY؊#i M ydo4iq[{, /j;\{c;,j}b+ BX Mw;_{lSܫ |!|vCfx`M5w D=;t9O[ H963o gjQ苑0|36`֑}iSi-hNXb..-H;/j% d sXMn+c`;[\rMǦR+Pv[g\!g> g&sOuORero+96X¶b03"Fje=7AZH(\ޯ}vDOERGfI\FƐ03FnҋF$/sv}Im.ZUѾ"NT۱jODx#>OM^ŋ<%{'3Vv!E4o#Vo1$ rP'6 6XuzQ8>Jok'+=7}>5<cBTm 5ˎZ!c@Ι9RޏWaTo e8YMnνdNY n#6() Ck9eÝ#˕ڮDW2sfXE9/Un q)sJtrRJky=l_ud5 lᜡW_0 fI\Pe7d?g]3ܮl+;|Bl,ّU .ׂ_XU! 92 Mʝ<˘>{gqIy?74PP*X93z` &j 2P3ċT3z $T܎ |Ûv@Si&Qe#ՄKsúW6$ϭdYB_mٺ2vQ5IcѦY"rʻM;A"u+zн [rA&G#-+r]5:ђs'(l8;:/*Gtд 92Cl\Oԯ"*I5 s>F07!(3ёMCRVc+殗^iEq2ꃔ7҇{Tv#tNv O܇OMC#pT1t:_xTĖ&xL$O˪-r \r ^vQ فg)/+X_4bU?u 5|`O/$ąoŲղ3+QVq{dt]'&,o<{2"ItK S;]^F5;Ȣo2Ixf"< ߇iQ~8s盧)8 ߖJ\% U\Vuk V 8o~l_ijLT.Pnw^EBhg4B"A3'7AIڐ}w*K21a}|6$ݳOwQTfbAw;F4Nfh߯-dmD9 ir]d1ct9m#6Gax†+{Lv)}k#IS I~PV ֢RG@AvBPA nO6+ #}z ɱ&# +V֬ Z dRd^yǡ\huv(G7 *on;։˳ie75Wwf(8X8+_#@g]51@zzLq|d%g<-Xx5sش,)\Y*Xsj!o8,-P,\i>3{ jVI8Og,Z`Y-狵k?0fK>s]]os( 0 FfC=5YSnRz[Ɨ1F.>8fbuQ /S|G&̯Ic7NkYV3ޭ}X6ٙ&q#H5NWA/+U]~욷Vll-=9Ɏ.kI(/aq-=/5wՙ5rmh/ev׶՜A& jic \8i1*Ҧbxy1z9A~Ŭ).NY-, l;rS'DD)Zh<2y؊v43PPY%kN-堼{~4[x 9ƑcRb0j9KB2=I,`~h@Kgi%ۆ=牢0L7vQ#Ň2+]EA#q6IPfΥ|{c#^e@]lhG"{rlqW:񟎷]]qJ[y;̺JŭlGhMٰˏi hxbܴP&1!]*O]ŧKǣai? ]ZsGqn əV1jl`|:xR+؏|KG iVӨGHZ8/:٪!+kl^j%]yM,HV=j1*}<)dC{:Hd.ݰwpBs1IF^vi0f6FX%{‘7#@G~Z[()13IϦ"4a y椄MW*8JsS;G ^|`Mnhv @ϸ18PEqєb?G8&;rlY$xIt_\-QO] E8E^`н] Cg*PIF3wۣ][EjtvzUa]|P&m[b kU77 ܙ,۷\lIUGW/F>|ƺB3`8y.:lG [](SBN7i=J.n1.T"fZ#{3kRePSvk"˨WEjnR)VN M9\ #9Eb\5XrLX `p2z؊9/lsGKdb#N3W$gܗv,X}Qrx>aC5w(wjCԽ-Kϟ_-8Li#V!^>~zByx33d<搄wv4^87ˣ7|Y‘8(orګ3S#!RA (0&I`Y(]efvD#- UV{9G.<~^K5uxܚ&*Tˤ۱FnohfC}{ʓG}Q,֑eo(o$ zIh–.+3 ]=Č.ѰH0i45'@]O^E)YG/&I~~qA\<$^/T<k28**+r2ц3chm\,v)":|1c`h?c0VRnOknb(EFƎZCFw/O$v9jy$b ̚vXQ!eSuB^>1ϔNA ~()7sO=>~jxrƇ}]M5TYg/ZsWՑuj(({2z1Ou/(q>ħDƻ3DkXHabU/lŌrcsL/.BNr0QshCnq_n=H{"Z*RcҰGT)k–Űz s Y5^M[pqb|^&6gz5Q Oڕ]J|>;.8{=G mtk[eL ;m!P~,Hۊ4Y+kӐ;iX,7 _L|_=x4g  }ДDEχ83o"H I%y&'f6]93_Wzȴ>ԗ]ߕ>kB>M͓cD3Khė3'l4-)8i})?,Z:+zT1n^yvU /-wEZ[DݏW;1@л}~T~7On$d&t>; 6 Aʺ=W<ho=jGWeb$#t> ~g` 7? oJyf;g4_Sf'GCx|Wo ^?mq7>~}}5.S-7b_Z΁MZV2zc"ҙ: ƚG4ϲR>>@Bi=IԔӶa'Wj[=Mlj^c-gN#ۢ:uOL}ԇ$Olvy"*?p_ͲjQoz)vn',!11r;p}xJBdn"ǾynXCL _8Nb %+;)>vU9ESmBʅkf+$ 8F?3ٵh^iYP(Wk^iml ^ ziCWFam3z'&1MylnPbbmHߦN0ȶmAZ'?AM}l 3쀺qf .Ifx2K Nm!Zˌ}&.d.f}@lylg)C!GvIpk2vN|(0Tjhxv553^RN*r 0(%#%8EׅE-\5Ԇj-|$:]*j>^/سac/.^d(]u?uij !Wƾ!>A7QcU&q/4Q3qIyfJg.ÍUueN}>^ ZQhzH2sSWeDpaܣ7!-C{gkt<+#[C5sbQGeJ^rE}!:?A{OXMBUA~3l,> stream xڍT6,)!4 (3]C7H0PC !tHJK ) % tJI|s[3kk׽i4%,f0Y%Rւ9@8Zpo3p)gyo"W; .."P7@pK!=Vm03`? {3P"a;Cs8 _%HGANNwww J GZ4`.0g77a 3z5/&u vps}p9@Pu9W9.wBp?Pss#`JH$`;j炸χAvP?'d%{s1w;"]8\v)r.s2R{{0kw￁%7 WGNm+ "wȽ  0'ܚwy-OG'#`yO x@`+?p@ 0Yp~oY pk^^;SQR$%ovn^;  . ?V5(qS`oY0=2̀Aqerr'Oߤufp;Ͽ슼 ep8o.QVY] ABC^@.pYB 4KHjvpŹԙ޿*. +`=} ^>s{ ޏ㏾} /`.o_ T8U}#N9ay@ =? 3ǙF T4_TJPGbːmI _pEHOnD].쀊>=5^I|6[یai3F r Plk7vzvР~*>Lt}*cKNC]G#1QIHdKVILLB^콥ݺL̕WR)O3ES~t+&;dHf :m d2s{. Y;?^hX< ft̎qV qܰ)ayR/Ƴ&7wMQYUz̨Ľ@-iEo=Ti%xV%zLJ;anpoSwY(CO_n5~Sğ52/ZpgdM˓/Ǣ\GMβ%M(?ފE-n=:ѩ~Prn+`c{7^5Gq-]o%:%rLq|`⽌&vy 08Mv]NutS^+ФíR|1mlBOuE> D!>' BNuea1FT 54s?j[qx+ةuSL0nȼZo,\|;m\AsKtCa\N ЇDSJJҒ4 [5Rβ#$jKN_o_͵|A+2}a \5ES:O<αYR ˰ ,>yW.b!H5Vڔ]5^]wR"J~A|m П(uWHK70UR)+Z 1"\>6|'3U6q5Ls}$h\{=&s,K971:5B*>?11a,N%P# Ud[~H !iwCeu~ CúUl+RuNyɂGm~kemotT]\"\X\-]!vUWT4 =u{Ή5s[QF}hh^5 tk +#TՋA{dimn{&&hٿuN#K<^I@ WY|jGmU*R EkzĸyC4󵣜r/'Zv2,s^* FN/\4??}^eVKEfVs:Vi$(׍4{Kj- 4UAƇ|4d1Ceso-qO9}n7(fX%jmY<]2ۮ 4%ZL&25ocל ׊MUxBpm$Mdqs󘝿{@٥ %uFݢTRm+ |Q-|z~C'noݷq5TxѰ*Fᅁ EqWXJ@Aw^dCv bQF '{O#oY *{^yoO=:F{x ؿ-BA^}} <e=,Z]ʵe25OS:X4x|DŐ!=?RuIQ)Mxs"-IYC}fO;KJ~ 2qoyC-\pH0dwi'O\?i'@LHHxEIHׁWswzDtǃԉK  bؗi-5XzH8ȱބv~.PzZ|Tm\vC9ab*]2/Sbtō-(u&HWzfStP=-@-9@XݦH32j޳Ib]Շr LhK oVqIb>>ZN{1W`Mygq6Y#7E[rMkALmrH|Üoh5 p D?'<]'4U4Ь AG0 <5}5 '&RbN85TzK&gVVXZ\ǘk2bS'5Xy3amrg[[w*ZT%% v+.>OM= 1w uQ4~-ݼ|!&)bliS "6`Bsez#_؎}KI+1,paj1D9z\s>O Br l(ܸ ^$9z7*82Lf[obvzX/"73I\>2Ĉ4q<F^Ltʇuxjg5^]r5'+iU9czЍ!^>\rN2JESc5\>*;*a b7n$/9 d;q )pn"* tȅ-x1.]0r,&&JU/0|d^{>HGA}ųځsF_rHN)Kt%'jU.#qUJo&HVa>#@g8JKqS#*%FuBjr7t=I+i^Wq1"^ذ."ţ8(!R=q, !'CC=˃&66ό7/t;"Lli06˫>VrG 5tb=GZLNj6zxwqhÓ\$|EKt61(pY4.ICy|v6" Wj>QxǹY3YvZ̍icDIi'~)=$1G ',@;(0wCMZRẪ_x^-iȞLF}nϒvzAhCȎRO{Yg\O cih\לGx6>lx]8f:bbYlώ#8a{-ٻ8>,g-v](l6E>B/Ġz|73SR G˸F9ڴ1ڪxpwXmA;a3:v8F%^Cr.捥)y-6H': lWe9c?uAj7LM" 2p}N:Fv N@M#|NswbՄ&JAWm>zՌ Ssq KھĖ=8 C!YEu'jI,d{lkPHװ3xꌨiEt},,W2-qR3^rx%9nɠ|n;Q+gUJ~߱DFU_Ϳ n}fxvGhJ4/ \&lX8S]Equ1V kحUFi,Q 3_Ml}PɈ2m1UfPԁ` 7sjʼnNh- )g/Z8ٝy|c E.m^IKI]ڿ:Gez۞Ci)u$%׳)chSN÷ P}q !aEI;P]T,3Ϣ'(pD2e.e K_20/* `oe yMLE@[#'S`ʼ)զ͓S& ~Ů+NsS`6]Ֆ,)=ŝdM.'΄ב^OQsbFb+HsOϸ?*>Aka37ġ0fAyC.FVb/m^H ˗$>XR~jCPO1(mWTDDLؕAA쇶VH\mT|,7nP+P󳢥\ٖQzCH]#X [RNf9*ᘎhXz4ѫumԣ5n$L@WwfQvghLoGKd'~Lb:_{xaaXcJ&oafԯpV0YTWc^6馳]tգ*".V[TOl ؆l#+1`QJ 'mgh Y5$BX`8DΉ_#{,gOfqFޫ{Ateu+6HjYJ+vZ,ruOLCʆ>˷}?x١dK0_.ɚ{aꜢ*22wݨiֲ;08yrx2f?u!dd@6&Ѷ^h{X|zd"Q?.>yln7a@[>iIw:' ղ䔀@SŮdl Y EE8V%ćJSӉ_r /Eu`&xL[0r}ٝ *VY9Ў8 mUs{ x'|TII=O >QY&0s,k endstream endobj 313 0 obj << /Length1 2637 /Length2 18537 /Length3 0 /Length 20050 /Filter /FlateDecode >> stream xڌP c]Cw%{pww .; NM=+`Vݽ@NL'dbgucgȩ01YU,Ó,le!4tD Arvik _C;Gn @ mg t'p03w#Ҙ A;@halh 3t6ڀ v@g AklFohDohOE pp6(@6K'[8Glgf@[' b(K쁶1- @9zXؚL-qYzgwgZoCCk'; B ىw À,fk"bgcuv#ww&. .@)ѿm@"?233tݍ~xR2j񲷳XAཛྷ ]gG׿&#- 1?tmF1I4a&v:bq1)!q5KG),lc1X8\O/߹+?%z2\ ʿ vi( #1:7#qk1XX{mfgfفr@ r6m?pp(Z851=Ptk [@t3)NKm2ۙ^=f6v<#h^L55z[;g T~ A0A\#h& & `X R]A v?.A v?ħ VbW@jOi@|Z(O?g:ahhl:, (@D 6P0c;klW[bc0Y@UY[:OPH\@D?.tM-\ ?Az#&Tj9_ ſ (SAPA1; ֿJ?tO2bŲ-؟m]l~_mfJ t3I_^LLBAgo5+:{ hXAMvS;HIhb~K;O :&Ph~#뿎 dz?'kC't38;5388FdlDA/duzI tܚ.pa]}{݁ˋv<BxntS|siTt^ˎ].O0T5YwBɣkb+DNa?u<{+w.<j"çS<`#M‰mP½a|u"tqA K7hy|$tW(wsoD4>g1,E^Z[̟<+Uzqp@ޢO~>JY*-[aۜ"!>֖Bav\撘 h`@W6?E^zOc&.ExP`$ >ܑD5F`{VV~ZsLt~kEx]W4^B2:39w dxtTŒf: V#08>*QqUzW 4NgO77&b)6#"Ks-JHDr:RAUj3I>g4R3S#Hy0C֖TuH[HI6M]^£Dpl<"y1RG wH{)(L[嵫ȱ_Fnj̔et#&x[{Pb+nw'ukI}&{Dׇ} P(?w i} #Dѧ;~g`vђ^TLʸ$QӺAð[\Mfu*>Feh7`aq6 CM Ch%;\Ju"P]BNq@ *<$QK0i,Lk YzoB$cYsmVπ2j&AEfg?-KlKQ[+REY Y]'wKjA[#O--(J 7)*4*"T{f+Kީ|< |/3M/rf1)]ruGe]0|?6o%2cgNɎ5ѸѺm=@!shN^^kP$a׺E$}f& 0vԃ])(c=@L&xz;3ʔK/3Nr4Ĝq\To,t0Ro+%+L=r/߅,ՠ~Y ? \v:S>;U&J+Usl # @[9u@@(ـ&ud$ ?կʐzP! Y !~52¿ο0X*0Hʠ?s6w##69a6De:?{c&%y/#IHy2dIRtkG,*);:cӫF~m^}jl%(,]ŮEևEq֫OUK嫿Oh$B}1m3"\VgצS>g%Ί3kE P[s>&Q(D:lBbM%O}(=(AY$t Z!i]J"1N;cxӕ3jP#g&;Vs:&/n: xmcLvu*_ӑ] ߵAXx)$#}bOg *g cRГ<8]MmJ=/GRI$#ىwF¹S#/Kk9:<품5DSИyL[Xhm)Τ[mf=@mό\$X`lӜ*I Ғ)6xL!ӥ0N(.j½xxqc!> 4z,nJ>?lɻ`5.B ng/qľIFExPBםVrʴ43ʑL4۹§H%/w)ɏWɯwN⥗0i똹nWv?Q,&kz 3H"n'g\IF "BF*r6q).iܑQ&;58a"7G5rޟ6Tj,Og}O eOP*Q2 Ts۶cf륎. 6훏Y ֗idΥ9%mz17mp ۂV N{Ԅˁٞ_ү T V䙤}ǚ}6i8=(O:Hx]DOқKseKڗ c֘)RpbWU|!x afQ0XUqE 7UxN׌(UٓA,I*ںHLO8Acamo0J!m=c.`&X1 XxC+b]热b6[1 a9o[1zQOĔL%YpkT_QHi,UyIi߄Z{hX&[P {|,E=6| G~6M!'cG`: ~i\=MNsY/;e%gDmyp8֣x$v|mݠ0llqW<٘| O$yhM"0m L]AkK߳; ?dyɢءQ zs?pw',B%1]'.Ӓ,vap B;\,&0ߑhZD.܃=ou|`dS/9&]sLIUb݃ 0p=ăU@$G}۟gZ""IB$Hs4'!*'0[,X\Y T2⍼ }Ox{9p|Br?j+>3R@pM_wA44Ɨc]sEKJ&MxHg P'Ʊ-@)<|~ pi%^%XY`QFN/N b{2 W#(uş{F5Ì\ 8U)Ռ6*,0z KB>o6SwӔVaۚL+i)BVf Yi ڭc6}3 <t:NWkf5 !Ɖ"0\pj瘙yA{PpכGxLБ}wA)XS$* L.YA顁pyɼ1'"1(WYʯF=Ir2^Fv2Rvxn f7, } 1JhWOe(OvRj:0*f#Q1ZMgIl5n(r04bܮc$se~ۉ<Ӛ l릆17e$FN[lJ3Y3Euf힋:|dgJ-oMkOjr) w-YMYDDxP\IxGz ޏxa>=ɍwD6}=u.{_ĺ=ECE?褔"鄾gt\K^/oZ&0'I딑u0 GM$YFcid3jg] w!sn Zԩ DF3#rNN cq{ۡئ|8"a燱2qZDcFB"6`q)%`>ئav~e4B%_ODH&ۏO^oI| !7edVv!T:4uSB;4|cbb{kG)o|(yG܁> 'EYC)kjş/&sڄhힳn{<`E\)5ʜg^ ٚҬVXNmWd486m>FɪO|GڕHj0o ]?LBf GER#7v́_sk&3 sWpWu{j>ʝ*5%8Ԃ919.̻Nzڠ ǒӏp;-/kȳxGP8pIiW8nK^[IZg1%1 d""$۩_e/5OA?%fhTψۖ)RyEՅ{eP&3 𥉉O[ 9NgyTfj2%Zh({ag[P"i&I'laȾ1Ϗ#Rtd^fI"YaqBR6оAE(wTabBDۈm;zQ>k+@k5X4I/3 ^["h~}4Д<5OGmN]f47ܼ{f$/(&/&Y*x4!-k#“3K~Fv6ӟNn&Խ.[KZt?PvnP/^Ť}\FYC)' 5W"hx~Yvbr~zW#y*eT~~!!!L_U&-3+Og8LҢԖ[Me=I mv$|9錄V:g,l'cyguXyݡR9SKL1JJ2mXW| +Uxml_¢sXcw chk@7d3U]Vxګ+u>FRd 鳭 NFBO=er5KcuI):ǖC b);w7UZW<֧ڰ|O^%8r>J^Fw#A%Os J0LF-uɘ9o8Z\ g5dQ@gV+-WGR l=~bsa+$7Cx MlxU<¹2M3:sӑ @ZIӰ8)MmbynTٶwA.F10yIhģVb O61i73XU\VIC~+9ڶ'M1P Ti7۟}2_Yg4j+H)Q]#\5dX:ELxKtk3ؚ4?]~` 4]ҞJ)fM7p FYu3Pmqkר%B Wv4F)`A.sekE>-i+`I`XD!ϱ^>3+x4L"C=J#O-Id):Gж,~Φ5;%jfwһiԓ9 A'nFJIed(GqĴGvz•ɵ?E6H W{+.};}'uM{p/#!Lm*g4L;OLGtr]FEbªW0&gPSvG?,"ѹȉp+sRT!ML`zʹC;Ȱ8X3ƝuGHkqPޅJ;ݴ(ûbB[{lQ8~Ȫ<,86`/xiՕu \|:8'!59- |nSS~#BLCTvdy eD#i8ѝ+mEVB!O:m4by7&+fe,vY숶k?rf0ӕbi?yύ8FS^}iOfTwOCk~$>>=a; Tm_3E<'&v~pqW2ǤtzX`LS9[rDn .R5.Gԋ>hnB};V:D:Kv j!w‰vr=6X*A^ z!Z:||319YFҴE:.Ӻk- #IQdS 8ÕM*x$/5jWeWc=tnZ48P{MexM6ufȜP0)s]O ueA@εI춒{$(1SA/8!X]MV!:-B)3?JHd'U=uXC!,DlQgE[DRCEb.ˬb}i$G^ ώM:qmm_w$Ec1Fc$3y $2wW⦞t##Hw;PWEݠkA1Q/OL_S{pJQD(YG(DAAփH fYL:խ$nHJ#GdjhĜG5;=z ^*].6w!S4kΕj}Xх\gsLhE.'FRl|BȞ쬯w ݖd[Az-?w)HL]4Re3-#_5)4jTc%£wL&wK hiKo+}>}9Ci?RjQƗ1@x>Nc1M[q6~0,'GXD [|J{H9*HӦ%{I9;zi@=UFU[f90(5-r^&w Q\*s$od7fs(El,U!fL<ƥoxr>ۅZ!މ8?TzUf'6wJ;*ASԱ`+'Ll}(͹tz(>q1hy}wut_MʬƷ N<\ B"R r$GG,>e-ndHG%6h΁eA>_>WG5Q KY.a8sA>nB4U͊QѼl:Eg%kYwB!C!5 W#H o6ůOIkkF[Ng/vB^Y=xg}׶geH}T܊uv#V3 qKO ,d`:66 2c*5L'Hq@B#̧)2H9x$ոl܄} 2'*h|G8%? H^S5 W&#S_kz??"Ud x{&[; i?b1k=ex]XΞ-4w6핢㢘˦:U(նE`oRJl9H0W "qa#4hCYv81GLoĦ>()rrp˫$aB.;*.o* J"2~sLFҘoԏcFV#R:hvg#s!ȹwg8ijǾtWՂ}98vpCUi#܇k1j0O'4fIȣ6 7C86N/P\.5~] bI لhb\Wa7,aOZM/UA7ZiƒETEwRC@5ް䎁J\(IƉuk#ԧv42S/n*SORKdP’HdGCcظs8H+;ld2 m%%%!1.{4>@|'S& [bCx`T|N=J/磑ɛO4s[,çV2#؜Edd%⮗.Jz؂ dV͉v+Ot hB>neq\EU ox7]I:o% h|;S JE4q82clY5Yd`•# 519ĻR n0KFaDرCUgы- ^hԞ;6{;){h^Y>k2 KCLYgٕ_:rs8;H!hcv-+bݴw~)Rʩ,R z=:އ;SlͳCu+leZ%{u+mVLiB`a(N"K{U Ad}fa;`J6WZ&EErĂq5l%1}HX%q{S<06aOFGvJϗCH.k5%rK04EX!Eya t>]i[yDPXlyk-z5KaW-WiBi,&G+~N[Bp7orʏVƪ[yhz! ?O#ʚc ٸyOqJ nR`t9I)z 6ۿcu-CZMxpJghG62j1j*w.ԵI_4v憯HLڎatx}mӱ>4&KDdgd41u^/=;:u-HpG?NIX)^./(C <1w}C)Rq,CFo=2IAx҂uWGu.4<1nrNAh4VTR(T @pGo; ?z-<|T;m&` ͅ2IS4Igi I;.)Io[dQˇobfK%= 9}\](5v'>() r=*3@MXK& w;) vg2נV0yB?|1KTo0pj, ;Rʈ沉LI!o>_@DL}ղR * ' :GήR4|͊]gYv-mT&foj c]}$e2YUrQ.7?8(&P1ʿfjXd;qY`|4;~xBmoUԫ ZD(GB"yi^Ίr59Ѯ'xH,pb tOEɠ7sx~ qC 2!@NK9Ug"MFʢGɞ6)S3N~V5ܹ\eLHġ/Лƾo d @Z{i3C57Fɑ}b'P;yAd/?,%JşE-8jN4G'W8ڢwo ,K>-ݰ[m[l+&d\^xU42x Sw*wv#'Bp/<C$W/і63oTؕQ)s@.3<ƷB^ZW)wAtJBoPZœ\|yՋ@ϳ@Ίq]@#A{w:_{5fXUwa,% E} ź~H].J>m27@P}0FQ'CC9U f:wjl=2fnNPynb_ !Ɠ XHhJa`Ԉr ml`$:]LF'aZ@{69[*{6ɢ`(%hP"𥨱1\aYڏTSb7 |fbl&xr(s1$2lBxCěw0t1, J nxO%Dk׬;` |H7Rn3eoҝNz`2g"[ ?,ƣ+Glԯ+mN!K8~v^ora#:xU^)L9%0?^`k+- 3☶Al]q7u"uT%=R4*h5TMN)*Yϥצf{[ *S$ZКEWxOE|6I+Q qq!=X|5:7J&^N}>z bC8I'Ɋ45gx:Vl26hF=ՁI&_x5ΆGg~J84qV,ߒQ4dOds"off뫓2NeX-zXKle~E(xF dRYGAGGcs7U)xXBdfYC `zH(+'«r vw.)ֹ}V /]5,MGoJ#TȘK&MM)G m)!qn.rO MEeGg ὠٿ?Hq@QNq~S;D}Q϶=q2Fo\ TGsIG8ӾG71o7=֥U/-I8hѾ$IU42U: {[Gԉ}D m&LߍBE+}ܭKEA }~ GC}'ϋ,+lNuk]+(0p\nۉ)OюOKndc:jq5=ر&Cm' )l7vsOVfgŘ-0O~ VRcXą6c*?j˴s St4AW*/ILr]L. cKG.V Fh{3r)BUQwUU'2rwJot$^p>ioy@WXHY-/DkY #⁃0GF:}ɖn{Nޏ>ђ;bZΖmqu5dKt;7Z{ZSc)<>8B'[Bn[OR)0܃9p0LJNYq$FX<-<'dfTCN=#>6Oi!$}\bhba_!L[FEF.( 0`p)ǒK75PeᶶQ[ +Or? O<`r? K{9B<i\'Lb<OMR$Dٓۦ0cCΕ %V{V81lÑᕼip$t\ݫ&UN^g-hN18 QxbRK:)%g{?G VP8L3Mhˀ>VVd ̕ 2Z|& VFg`vk&Ч#ַQ2<7TKRx_ x1m)`S#Lʯ 멖]ȕKFi»~@nP1%P fXy>X0tIvjdPX`-RwtRVu煼hIvD_Zr"02tJ5*}HAFɍlϥn |H"\υwpFa8 >ظyo6% J'Y}GSc tģp~ >]ì^] 74k"Mg-ޯw~Ǧ#r|.Sc,*r g-)M$9nsz>sM;h5 dN2e=%&֎@(5;P{dGe:Nmí]~ l;eȀV1rM/94)0P"Q 66v|2x맇qkGCkgpT=?OhW':|O_MՖ=8OMbr:"3vz }\\: (-0!b7YD'ԬKvhߍqCU1`Jk{soi,Oyq).+L¸|aT#uM-U!|h)0ZGdgj;:Q;.0ADj /]߳'9$.Bp&nE<]==-<딡OL lY;rQapj`-?=l[Y+g9hXaBH"ۨ[HA.j;G"̀7oA1SaBY+JL*1yyWeZs!!~Dgk&XpvNUήl0z\?۬"?9G?ihB2K2SП5~擡XW ^&lFm~Y<}R\3`'Ԩ8.SVi5d9Wqo,Y79wHşpȀI~E6zu.IOhʇھ!-zxnfUE6ƯW3AxЮi|KRa/YfB~$r A #ӓ"V1f\d (Z6M11]OyD=u)|!Y-ZC9롩MO1p7m8?$1**Hٚf|O/YQk4x2HH#a|((Ǹ-F1U[0ly; P>sOդ "T!NsS%SwG;.w(2 1RLw:0QJqVo>R=X)\A@Hڇ-_Y0ѧ[l'V3O?靹]̇W5zv4~!;JrjWZ(l@V 꿱Ke v:26+o AFx$$*.A">ƿ[m\ a&|c?e*#Spq=ArYS ey%%d@lI/Dd{)G뷾pt*]BfؕTF9~ VD}>usr@bA# `0v?W9Ic4۹+X'7kN'|k BI9$C,|9xN: Hd5A,1]k [}M' x.H\T6{B@+fb_U2Mn9_x@ܰ|8d6V W q:&8I ) .bc?p _?ynK3WZ >T{u "tlydN`5ǣ f;NPUiuIK{GĬ| g/mꉗ"nANl\m/qٿ&Gc# IFβn+<`\-YٕLh/PvF&vmhRbn5^p//g#UY'iKLm@e1(꺩eq7> stream xڍT 8m۶U -BxAbBBE$c X##!R7e/"5BP!ms3s^}^yp) kE<Ņ`@!5A+(2R6 DaO4BK%`MK)dAZVàP #BzX# @u)^TՍj 逎' dKw#xBqX`M%4t/ z /Hw4Շ(ǰ jqi"K%d TXǽfhgB y=Q .Pѱ%nᨠ5ȵ2Иx]'LΧR 8hȍ S|Ɂ?$k4 /-f6b ͕@TP(!ee pnȵ6^u'z q xD!$X CT!(wǟFxG\ :d&cPkNC S$_WDZ}~'H߈̠CaNГlN {XhCtȮioqnq PuH&XPh{(Qy@o uڨ?;q)X*CARRQЎ ~2 H֮T] @bL! HOD$$7x@U$Jyh$ʔ T7U$7`?cPГ.]hh?D p=F{IX"1_űv[Y'GE|Yj.}RΎө>V`J) ;aӛ)1e.# g;/OJuuxWJf_v] sc/& 5e* >n-Fq_ٲ!e>:i t?`6>(n0pSvp(E^G'TEM;nhxPVmS΅j(fb0&rdY].-մZå1~Trx ZM{EȎ࣮mi7d%{zm;+;U6=lӠ SV;;ꯥ40"(E}zfnxe֪WI,Rz}K9v2XpR:_hq{֎RfEvbvxG\q >~kgc.xgH줛`[~ ټ nw,뢝,;jj"i}h vm00oސ^\dkSU9:qoy=0sj#jdݕ㑉V1Ye>߆nVa0ɾLk[VF_ez DV#& .;3 5.,d0_ Gk ,E\jz<|(dLqҹ٫ Oe`Tn?4٠B}C&M[h}a/1 rp{l]zӝپb^^|B&/m[o9ydo u+lHjà4Mo,i;'5Lս2fʺ0]ѩpȲd Wh[sk vZ-KF҈XnO㺞2[6&yO@tFcC$I ڗM~?:vqlEM"ZT ~t>#)E]L5tX` F1SUmPSM&Z\H݌'}W#XDW(Kڂ4>פ?!9v&1+!y6Չ>_EƖ4!Vc!N|BꝲI٘pxϕ lw.|a:|VjTyY3?`58yB*`2#{?u1\,iE݌쌴_EIj+!q\ኘ%VNS/e r&X(++\TOYb-m79"wϫT?Z\\$9_R3*GI'-7qgX\\wY}D-G%"%W_H:\n/v)a>fsTȗ3r>NDL gZz&"'q9Z M ??4mo #tI7sts>T`ciƑNO@$栺5e?kkᮯk%rĒ SyR46-2( ,q$\DXkf5pg]h%5Q j,ք/\0 Ys8IUM ΄hLo߆$:LZl"] ~%1ZY\Kf!i;m4.{;Gg/(f4Ls|ŨӤ9YfʹomW (D@/g{!8T GѺe82(UAشXHmw;B##Ű|'%/+]Әr1엟ԒD $>1y%'Xs{Qcexo?On5j-ML8qgmU=#]D%˱ !GO$ Wj u%%|܄l^y &w|pCd .٩[F`5$ƃԬ&$g"L)Ά'Yh (8/Fu~) R8<.o 㬖3^fr |`g ,}DTu,؍c{7b?!rõq^RSa ^``h[ {\]×,qXvncE`șJv/V7 IA>WMr< sP!ғO=xZI*pE#e/,B62WmV('U!Rn:h5:~"Eb .0D Wm7dV=K^'=dV@*; W[Ɖ=z n.x߹G endstream endobj 317 0 obj << /Length1 1882 /Length2 5603 /Length3 0 /Length 6745 /Filter /FlateDecode >> stream xڍT>NHJlD0`6FIH )4҂4*Ғҥ?;;빯8ٴ6pe4 'H",898o3"(1poSqh@T\  )@ 恰4U4 q*]1G~<TRRg:c09‘ma.y#*{zz XA4AD]8?0$3A'q0 \pᎲcသ: G V*0[[4F{ RVyG <` >g0@YA \qXA,E2[SD#p џ_7dQhOo`@ a 6@!*JC&B  aw^]?f<?W+`'C_ ,0p?E (CSoc^=(^^vhb #  "$"O6 5ȟz*({4 a[< hCD!?gLS*7oC..?)gG+4/FMӮ V;A-?&GJMTԓ~]Ū -55Z 6jt;=wm--ߒyqPA]&HI ABB(A!ōRF䶷B퓅d*WݴK-bj|Moy-G_^R)Ahŕ.Q¾3ZYtqm9nؿc.}z'^,hS2﹅Fo%*/ ـ (sb zvHMcT灸ga[GkL!<}m[uY eOqo6H@hݺ?ҏX7F O7ӤNN{w+ϗ_^ͭU V sE`2e){[.ۼ<-Gv1_zF}iym% SV^ KX >[2ܭmk7[R"y:Jl\0oZ5Vt%I{303ȑS{m[}'=\.Y^TEqmJ2(6yˏ\jKNYt=8',nԙʬfb)NiY?N9E;4};8/>7mNӴrJ սvʷ5lIF؛pabʬ]̫"fk:mYk{l+ʌ"TӃȏV,oXu¸MJ+^>T4-~TķD\Y2}|T~[9p1ِRZ ,pA_k=)Tn RLqr8n5vH&e#HݞX "]A#`{*wVlHT "((mLSabzo1cWJZR1yw~*3cIo_1e"CS^$.3=5mnf+ )p|2`9FIA RnVB®č%9[[,(І2{ %1nO8 qЖ]j rWiXᲤ7㮣ٗVva{j˔7_]zjvDy|]D}b kθoʹX_{d29\&-/\Q"U.R#bec]1U ߟ&~" .nTZsҗmurYA{*Jn bFO{/`h ㎨h5wSvfAEmqONHt \u| DO6e.أ w| /|nL,`A OfVUVq4T{Y5$֑[1{RK#T/ )9 k}2PeDtHzEwak3sp֡ǸI V*TtUnsEIY%)R.B5!j>O^s1d_7Ԝ>FbEFt.x@ޱś7 9L~߹?J?SI 4P4v7U.^d3:UڜmyWWbn36%kqL7 4J}V_Z.: "s(Pj 3{w#'"fm-s^ҟiuLXdL(8Yȼp3|OդTKe֎Ne.9 $qM@v鰘#Y0 YUr& ΠCiHxu5f{qȧw9F[/ٳph-"܌Vf",¿BDN\ !~`!B"yen:7-Yqn+>Ky-1j"C+cxfh>SԚxa{j UjbeL%trPB9\sKvRm߽ŽCzdD*Sq2*VɈ(yAD/Ksw)G$b K-W?li#H:.-eP儁"؍Fb͞N;.=o%N(-0n6[hRd^ѺdvQrlq,./\E;;f}ߘx^J<)^rB&=rWN哜/5ߺԶv>_z4ɺ22||,a-ݳ@S̞޻R&HGHl[WZ?8>'ZWX;[dMwHmsI Y1wAʪ7ٍV^>O{d_zAGS㬚 $XW1ztz?i슛N^­ :ᄎ{nۜrh"ݩ#n03z7$U{,na=j,|w&j㼽rkG w=JIRIL|_MNwE~?U5#;_A@ICp?T %)vM" .ްgO2X7+TWVx&Bh#qwuY>Z~&?f z?b7s˙;lN.\ͪF٘#$O:DRcsƌnD:3p *U^oeI W/eVZ c Vh<|+K8>[|MvM<~ߔP@\n4uyaprh:7W!_ZvZ434=̷2!C )K2K);dx3# |qV J i^Lnj+:CLvIؚ}m/HAez"6d $o9*LG댮#N3_qE7O7LEנ _A1~vm{L߮>Xs<69E.qEZ}J$ٱ,!_:ɏ8h'RL-OCaт5r 6e=&Qy[ޖ+ǢD4gIXRWjqJ0]6`VNՅjD ?r ?VY/9n+dievXV8{lh ?-[VK![F!nwDbfoqQ({Omch)~?{w-; NBKY2tPP$5N*tXιQ+z7R⏟EdF0Ys mC`M Of\ 63%vՄi~l[PۮH`pi9l)ќ PHk!!H/P5f2Vk#rZ%/vwY[V7( :КE7$W>&"b"$ _Uu*X>ɘt?Z/Dgs%EnPH Ps< ^HtlGH,'cQ/e!E^]}`:d)4]KzMAy^C1@TXFsOKư9- x,f ›DMdl ۼJe-c7I8{dtnWK0 IIJLѣdx˻NxGեM ZPSw@Cc0[:#K猝ISwIٱo7bB[cN}f)d]תda~Pk1p[c>A8Fk}#jGBcpݸ= jѬ)2W+8V1pfh`՚2Ô;Y1~fR+RƯ6ЂhT{|<9Ey+akFa=|`A> stream xڍT6N DJniPc-H" R!%! %9s}⺟뾯=V&-]n+%T@qārOA AH 䜠`MLSG"Ov@> 88*D:.p+: u!ܝ02=B؁|bb"\ہ2P'8Q6P!`;.CPruuu; `عp P urZ j("Q`'(&`@7h x8PWE EQGϽMg/"8w3A;p h 5xPn(. al猼v`˛o*h7 q;yv$e@9~< vw?NtEx +_"pG4TEϒ  @ Q> uQtZ߈zí7?Og rBC=/ #߄wA7~}~2aOוC9YYГ[/  Kj>5(K˟xPoAnXoRDN?p;? nF :f4[cաVpfUPAF" jGAl~Ca#ZHgOf 7QNAo+* H_S/$ ;9s =n @^uQ F:~+ZĀߍ#y@^AA Ϳ/xCey7f*Aa /_F7Ͼ@NN7ol_A!HD2R ܞ$x)KN2}d O1^{n77h7]z]G錭7fGlTw3~xK k#ZD+ܵKɭh~F*U8wijpIL)[(n|7ɓ O8;FOy,czƳ /|Ij& ΃1h:2;eV9̳jٽauŠ;ШѪ=zk]VzYϩ)n%٠ s7IYrˑ弪5h`[HgEV%R.K[*,0sdy(ۃbDӏ;:g%Zr^-!ɾπiQYH,,g5/ o8J̱Q'xJeOO0e"7)b=eUГ$~!Bn/maXl>)9K Kꩄ1X>Q[ΤV.G&*V$ȃF[ 98F?'!Mߊ,E#X,?V^8Z<0=9^W1a񉗚ʪ7.uT)Lk_+jt9pՆ aLe%/Ĉ]y:G6![-ϏK/W-=My^0/>]u=Fgvϖdmg:\P. &՞ lxʠ.IOc"V@(Zrь@EAjc(Oq?(a4sU܃g:frڂM!?I<І)Fis]쪴2 +.)%w;WKN#yحlVru\CMG1w<{I'8oMڞQbĝ6K?le὏Ly/)hk{`at?ԃGmzm3ts]R?Q0#6 E#% fg }ǘw17Znay\p&|%lԊ"a^( mfHn{ 7mF}m<3>-BY@)lgP|a;]P+Qel{9BܯowǍQ@ķ6 QJ;pMG#f`EzijsOT;FKpxRV2B\!2.=#L ;7J :@|-yj%)nvto%ͅ;,.P~HHITueioR\--vU·z${|d&4xuLyьu6Ђ 7Gœ1HT&֠k,A_sn\(~@Kބ[#;=/ IOk'oFjYd ª% ,k%a5?fL Hbwe/<>XUh T"OZC g&8 Cp~&pazvuo@PGb/HlrdVhG1\e(f7KWӉN8]Q&q ɂ+(^hV* Ћ~6Y@oX)' Ӑ2 yÔ+xۑ0s U< q{:"Yr6ҋf\tR[rŹ{I8m,H͸;DVF643^ln]kk0-0E^׫!| 2#^o'pRhŅu7+b:FS|=8H4 F`CI)yУ#u͡k1/^ʁKb?]zJ=[:҈^Cz?Q:m'(S[tu3fWKJ'hL^ݘkYi+xF|RF2p@LPOqen}Mʓ+j'ƕWؓEF:X vs/4FmF_s\N GҨ/N~juTIu.!ELغig~K_yC2> {\UW֟WP^X;FU87 YX0DZ+6妤< t.ţ0 4HC-vUM[GBQLf1lN*T"kk Tg)[-k72iAꛮ% dxK9Hh)kjz1 o*J߄_/۔48a$R|ԗ{#z_1 6094?vshw 0˽LesoK32:/·zi}' !;_NMMߣ0_2ZS˞*} V90\XL^)4D) ;62u6g7+IQ|.< ӌ k;6bfG.Uht=E椾a)&~zc0ww5i<t.I6> GŰ8^RS<GXo8BfV8bW:@p T*솽`}oX(uX+|D  "?WᎡ0xjt9 ov]&_v"˳#jcZͺJbw/nN Mq>"zގT|Ya~҂Y8xRWfnV\*4ɏLI/6'^V)|9k\Br5oUݚËt5^ @|oPܳ7q% /NU3vbSIX܃r~tm䵋ጆWLm !ai=MfY쥅Ȓ-?6$$.V>LL"ʳĶ~otg61`&SSiTY2Q JE8An1 {(VW Oغڎ`QFΠk؝7SήO#؊ 僔Ki_D}:fI͖eԌ|\i[ Yc.֮43ͼtv^Cmb1/KnŸ1Se:ZJNV_j.'wu2J'f}8)ȱ^S|6W|t*oj+6UWejD{tl]c! g,=s#DlHc߸Gbo$&âZ9|9ha`>:ɀ7jJUcz{b<f9JaA(|1lRyŧ,( Rb{99=Nspn(/qb;2i ƻ(pH3T=No|f@ΙM1m%9 LrE㚌A# HQhEWG8!M$]2tu&i&#Y%q'OrRb$v$NizIN }!Y>Y:#!v2r.a5)1Ae]|ӂogv ׸UGF"(J;MJ0'{쿎[ljp K]`Q§goF}0^ lA,/8a3|"b,؞baS_pNe 1(=2 dc(tꄅ#i-9+LhT],tyd [ qˎ}Cx _p] ;q;3/˴ H+2"}`{ fIy1~ևXRNn%.OE֙.ɦ(8 sȚYZӷa%ˆ؋4,uѲwXRb'N'׎.\IAzdqv!O5(lufwO߯˿;I3t%'En#-VedfǓi 18/{ϭf;Ғ٨:ͮfC9-ǻ ,Zfq?g&}!g UL:%Bq/:ljfa|m<pxKnTxxʩDv)4AnC 2!`UnSԽS-5w:Q4-e t[7 ֧rtE/qØGhP߭2~coDwM3vMkڈjhsZ&QQtRS~w9 @`C[El2c&⠽E[MڮI] S´ 6ܲ߫lR^aQMfu%}vϠ5\jp`BCnB&'L%jaT.KQx58 p:MxWՄ1Dۻ/I~|MX Ey# 毲]kN&u CE-U=~TGs+DюP=ۺgCQZyV"<.},VW;TDslG8SSIhU>1?ɫdE+/󈄣!x3U 9 _?tjs5%; y)j'sQG2rn-wg/qi'rĭkZ843(hPϾ3Ol-]mg:a2kl:+g2zk᎕m:]oBc[lǑ'\KdQe~i0E ʌ%qC QI*oe YY=~{؛*1SI˚lT=}Ux5(SH$w:_#}vs eVW瘶;6  u18É@AGJR]m14|ϵQ}3ߗ5WQӑv~m 3 Yt 蟶PxyUemE~+i1-O-3R4`'Yp4ʲ/?}hݴ),!//׈-jFxg !?2Qb[ͬZh@͓ g'׋rR2Sl[\HYAqLv{ιDrmεk̅[?<:ܔ+6Z/>\ly9٩$L)G%΄:Z8bFhǛ랯4~63Auήi\-gᵱ'b3>{bxܐ*xJvthugZ&k==Hs>Ţ!Luf܆1tR!'6ڞPGIJenܙͲMɉl| %q~Dx(`\:K83 G^눯^Le7kuɗԼ;XzZTس4Wa"0AbWD]r_qv_$5ujU=)@/EgnAsNkYvoZy҃q'r/!N?2xcDQTr8In6uvX <92kլr~p}F}T ։aT\r.Nb ',%@@|r $De VWg1GX[Zл_W#πa8N\_zw/ DhmKDPMU)y ˝Rf6F{o|=IY?C]Y|_/o}L0K~:ht+2\3=4D |+IҚ4Q*ϊQÏЅƴG|mD+esE]!W(U#)'ɔ|ͯ9z΀$n{^@ -Ė~4!-~ieY3O R⎮r]-c`[\Gȸµj3f:d1D}.z긾I_"uxDG\Y2Fb1x7c'++^鵂4OӚG@OBjt]>fbRFcգE[%=dW'0 3i @dЊԁ-@Ƅ9aSGh7,Z>Dطއ>|,_rI8~Jtӈ/j14)@Je&]nQdAT˄udgPI T[bOՄљ:ȣeqvڏdNGSgK*W(F)$}5[rpV{=(s7P䖯Yddajo> <kc`v%W8t_;Xcm#-Q4ZZ9:,4ۅR/Sb? endstream endobj 321 0 obj << /Length1 807 /Length2 1509 /Length3 0 /Length 2099 /Filter /FlateDecode >> stream xeR{ yNl;034B%%;saF U#S=DEO.}/i=9眃tз$3]L3n(켡ʐ+?l׏AݍHx&$*˧CJR'22^Gf kTtbY%:z5/9;}.7Hf ƻˉ.~m}<#sk:/6S9%I3ז}ulQtj_'.dɖ8yْՊsW :۴p@vHǝ6*\tVm\1M#n=W׍_]m/zn|_|LۮZ4lZKK4Gj:GAن-S}#V!Iتgk#]]m uˋٓ/V;iO9:_q<ӲuAQ!a 0}RJksUfŸ:~͓JհV xߜDz /ĭ y pB'gt`05%C\׶c(iaw۫Nu*3;dDvfVFO9x_nUO=z&7OܠlO2ޯp,SC`y9woP(`~Jp78ϫ$+e4PyLjz=3\|}e= !1JTo>TbUߦy–ۜ>um駟*jm:`0n\(r~?l֝/mXn,1ҿ}qg]au@d (3lYe]c6`Khґ'ܼmlYйΘ9OU JNW@+ \GƅE/'~xjiSLEKHAUd^)@5$kl.{(X{R'8xO=Q/ԚɰBi} G壓"/T㌗d˒OB'UD5zvz([%p nkP뙳ӡ U'fh͸m*{yAFO0:/_df❣luɣŸ#^ endstream endobj 338 0 obj << /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.14)/Keywords() /CreationDate (D:20140304131505+02'00') /ModDate (D:20140304131505+02'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.1415926-2.5-1.40.14 (TeX Live 2013/Debian) kpathsea version 6.1.1) >> endobj 269 0 obj << /Type /ObjStm /N 85 /First 780 /Length 3819 /Filter /FlateDecode >> stream xڭ[[S;~d~:uj`B0rRyp`clK.o4h<1TŲFSuq`$$a$FM43J O *!E Ix 7BN-0#.pQ$JaI",ʂYH :5zH-@+aDv8'Т!&Q4sJM) K4g*"R`E%($!^Œ%0ݡ%RKϢ<&2X Y }y Fll"JQ58 (e"5BM"P6+&x"$0 5o,6qI& j03M)7#*4FJj)"D@+t$$L85*BaK0A6`̠aXѤH2 ~+P8P\j[ Ls r @c+0h9_cWe0{Ha qv m^Յs%EB4u-jRQՅȕzYF"A ʼ}tqhwv|I )/sPE}O)s9i/}nң& J Ղ;?- =! vu622Ơ:y Љ18L Zn}on 빬̧#uk d.j`=RG]H.-[a#*\^җKJT0r^[fA4zL׷{EkD u:.1qX}=|z^/?$M7z:|O|<7W'ӏo{sE  ng;;_--&qo0ȗN=s` $wo<I ۢ`> Ƿ,yvNzwM<L ǝ_kō}H6BIw7i/OߦQz~HOӳz2ӛ4K߾ S}-H+)Ueє+M'UlX{?]_݆F`(*IKH[dqu#p2 G}&TPYNA>APZE0ƪLFd=7k¡}_ F8w`˹2^ͦ-Sf0ƣצhe9;YwOEކ7W{ASjcq<2и&@ަx?C\$}~5ad`#O<i k1fzm;*Vy{igUlW`UX1i]O*( 2?^ #Iʇӳwa9p(9,˓xQX]6|E[?y鱭HuJ.V"k||J>Zw魌bZw)DDNZ΁#G5ab0r?,1l{-HLۼUn>tDYD <}Pwfݩ#<ߒ:05?N誸ZeÝw} ɣ FUve`wW[_HsU9pINҿڝo&`Z Hyt;pPl6+h1+Eax(tYnV ~=f!Nw{{>v_0C|2Cݗz#iݻ}!3k 1GyvrQaKi}rzwKyCSyr x3M?w:YG1s%~HKܘkE!|IS-4Dg|u)=~Ta2Գa =Gj_S=isOn^j|JJ^p΍x\>[<2Vt`|3FOE ] Uׁ"nXA7C iA=ZBWB N*% ː]͠w[#ō2#-ƫ7|0NI^6Ǔy֥!Ѹa+[k+U@OaVPnȕBE55ռƿ[-Jz=߳ߐcs|C ov'tg̦ Ok@̆- „Z"8.~ǐ7p;4Y2̓ބ2f5޻ ->PWSuQiFd@B_u]kF(/"=YsRmywt]FR >a..>vd[hG͊v[k_ȳ:(]jJ'7*&!ɿ}q6`?@Ǣ=4(6r`w0&--f8a Mn,+'xy3, endstream endobj 339 0 obj << /Type /XRef /Index [0 340] /Size 340 /W [1 3 1] /Root 337 0 R /Info 338 0 R /ID [ ] /Length 834 /Filter /FlateDecode >> stream x%oMQ:瞫SVZT)j>w0DD$"a "iGTLJLP#o9sC_`_I0J# Vpd  b}I+@觧w<0C'4r1++OYVkGY K z(+jznJPEo^7e5Xj@-X :ԃ`=h@#h&4-l@+m!i?v6&6V];IkAXHA7:I%Wru;hB]#`B]Re![@3Мx!U, G#Z^wZR~qq #vng}cyGL @ R ɜxi,*1GJ+YxJ)c||U*VB+YR{%VZjay<2KҳJ,P*dR%?+oJK~VcjK]UZcj?}Z }T':7w՝} endstream endobj startxref 414054 %%EOF NMF/inst/doc/NMF-vignette.Rnw0000644000176000001440000015575612311534443015422 0ustar ripleyusers%\VignetteIndexEntry{An introduction to the package NMF} %\VignetteDepends{utils,NMF,Biobase,bigmemory,xtable,RColorBrewer,knitr,bibtex} %\VignetteKeyword{math} %\VignetteCompiler{knitr} %\VignetteEngine{knitr::knitr} \documentclass[a4paper]{article} %\usepackage[OT1]{fontenc} \usepackage[colorlinks]{hyperref} % for hyperlinks \usepackage{a4wide} \usepackage{xspace} \usepackage[all]{hypcap} % for linking to the top of the figures or tables % add preamble from pkgmaker <>= pkgmaker::latex_preamble() @ \newcommand{\nmfpack}{\Rpkg{NMF}} \newcommand{\RcppOctave}{\textit{RcppOctave}\xspace} \newcommand{\matlab}{Matlab$^\circledR$\xspace} \newcommand{\MATLAB}{\matlab} \newcommand{\gauss}{GAUSS$^\circledR$\xspace} \newcommand{\graphwidth}{0.9\columnwidth} \newcommand{\refeqn}[1]{(\ref{#1})} % REFERENCES \usepackage[citestyle=authoryear-icomp , doi=true , url=true , maxnames=1 , maxbibnames=15 , backref=true , backend=bibtex]{biblatex} \AtEveryCitekey{\clearfield{url}} <>= pkgmaker::latex_bibliography('NMF') @ \newcommand{\citet}[1]{\textcite{#1}} \renewcommand{\cite}[1]{\parencite{#1}} \DefineBibliographyStrings{english}{% backrefpage = {see p.}, % for single page number backrefpages = {see pp.} % for multiple page numbers } %% % boxed figures \usepackage{float} \floatstyle{boxed} \restylefloat{figure} \usepackage{array} \usepackage{tabularx} \usepackage{xcolor} \usepackage{url} \urlstyle{rm} <>= set.seed(123456) library(knitr) knit_hooks$set(try = pkgmaker::hook_try, backspace = pkgmaker::hook_backspace()) @ % use cleveref for automatic reference label formatting \usepackage[capitalise, noabbrev]{cleveref} % multiple columns \usepackage{multicol} % define commands for notes \usepackage{todonotes} \newcommand{\nbnote}[1]{\todo[inline, backgroundcolor=blue!20!white]{\scriptsize\textsf{\textbf{NB:} #1}}\ \\} % default graphic width \setkeys{Gin}{width=0.95\textwidth} \begin{document} <>= # Load library(NMF) # limit number of cores used nmf.options(cores = 2) @ \title{An introduction to NMF package\\ \small Version \Sexpr{utils::packageVersion('NMF')}} \author{Renaud Gaujoux} % \\Address Computational Biology - University of Cape Town, South Africa, \maketitle This vignette presents the \citeCRANpkg{NMF}, which implements a framework for Nonnegative Matrix Factorization (NMF) algorithms in R \cite{R}. The objective is to provide an implementation of some standard algorithms, while allowing the user to easily implement new methods that integrate into a common framework, which facilitates analysis, result visualisation or performance benchmarking. If you use the package \nmfpack in your analysis and publications please cite: \bigskip \todo[inline, backgroundcolor=blue!10!white]{\fullcite{Rpackage:NMF}} Note that the \nmfpack includes several NMF algorithms, published by different authors. Please make sure to also cite the paper(s) associated with the algorithm(s) you used. Citations for those can be found in \cref{tab:algo} and in the dedicated help pages \code{?gedAlgorithm.}, e.g., \code{?gedAlgorithm.SNMF\_R}. \bigskip \paragraph{Installation:} The latest stable version of the package can be installed from any \href{http://cran.r-project.org}{CRAN} repository mirror: <>= # Install install.packages('NMF') # Load library(NMF) @ The \nmfpack is a project hosted on \emph{R-forge}\footnote{\url{https://r-forge.r-project.org/projects/nmf}}. The latest development version is available from \url{https://r-forge.r-project.org/R/?group_id=649} and may be installed from there\footnote{\code{install.packages("NMF", repos = "http://R-Forge.R-project.org")}}. \paragraph{Support:} UseRs interested in this package are encouraged to subscribe to the user mailing list (\href{https://lists.r-forge.r-project.org/mailman/listinfo/nmf-user}{nmf-user@lists.r-forge.r-project.org}), which is the preferred channel for enquiries, bug reports, feature requests, suggestions or NMF-related discussions. This will enable better tracking as well as fruitful community exchange. \paragraph{Important:} Note that some of the classes defined in the NMF package have gained new slots. If you need to load objects saved in versions prior 0.8.14 please use: <>= # eg., load from some RData file load('object.RData') # update class definition object <- nmfObject(object) @ \pagebreak \tableofcontents \pagebreak \section{Overview} \subsection{Package features} This section provides a quick overview of the \nmfpack package's features. \Cref{sec:usecase} provides more details, as well as sample code on how to actually perform common tasks in NMF analysis. <>= nalgo <- length(nmfAlgorithm()) nseed <- length(nmfSeed()) @ The \nmfpack package provides: \begin{itemize} \item \Sexpr{nalgo} built-in algorithms; \item \Sexpr{nseed} built-in seeding methods; \item Single interface to perform all algorithms, and combine them with the seeding methods; \item Provides a common framework to test, compare and develop NMF methods; \item Accept custom algorithms and seeding methods; \item Plotting utility functions to visualize and help in the interpretation of the results; \item Transparent parallel computations; \item Optimized and memory efficient C++ implementations of the standard algorithms; \item Optional layer for bioinformatics using BioConductor \cite{Gentleman2004}; \end{itemize} \subsection{Nonnegative Matrix Factorization} This section gives a formal definition for Nonnegative Matrix Factorization problems, and defines the notations used throughout the vignette. Let $X$ be a $n \times p$ non-negative matrix, (i.e with $x_{ij} \geq 0$, denoted $X \geq 0$), and $r > 0$ an integer. Non-negative Matrix Factorization (NMF) consists in finding an approximation \begin{equation} X \approx W H\ , \label{NMFstd} \end{equation} where $W, H$ are $n\times r$ and $r \times p$ non-negative matrices, respectively. In practice, the factorization rank $r$ is often chosen such that $r \ll \min(n, p)$. The objective behind this choice is to summarize and split the information contained in $X$ into $r$ factors: the columns of $W$. Depending on the application field, these factors are given different names: basis images, metagenes, source signals. In this vignette we equivalently and alternatively use the terms \emph{basis matrix} or \emph{metagenes} to refer to matrix $W$, and \emph{mixture coefficient matrix} and \emph{metagene expression profiles} to refer to matrix $H$. The main approach to NMF is to estimate matrices $W$ and $H$ as a local minimum: \begin{equation} \min_{W, H \geq 0}\ \underbrace{[D(X, WH) + R(W, H)]}_{=F(W,H)} \label{nmf_min} \end{equation} where \begin{itemize} \item $D$ is a loss function that measures the quality of the approximation. Common loss functions are based on either the Frobenius distance $$D: A,B\mapsto \frac{Tr(AB^t)}{2} = \frac{1}{2} \sum_{ij} (a_{ij} - b_{ij})^2,$$ or the Kullback-Leibler divergence. $$D: A,B\mapsto KL(A||B) = \sum_{i,j} a_{ij} \log \frac{a_{ij}}{b_{ij}} - a_{ij} + b_{ij}.$$ \item $R$ is an optional regularization function, defined to enforce desirable properties on matrices $W$ and $H$, such as smoothness or sparsity \cite{Cichocki2008}. \end{itemize} \subsection{Algorithms} NMF algorithms generally solve problem \refeqn{nmf_min} iteratively, by building a sequence of matrices $(W_k,H_k)$ that reduces at each step the value of the objective function $F$. Beside some variations in the specification of $F$, they also differ in the optimization techniques that are used to compute the updates for $(W_k,H_k)$. For reviews on NMF algorithms see \cite{Berry2007, Chu2004} and references therein. The \nmfpack package implements a number of published algorithms, and provides a general framework to implement other ones. \Cref{tab:algo} gives a short description of each one of the built-in algorithms: The built-in algorithms are listed or retrieved with function \code{nmfAlgorithm}. A given algorithm is retrieved by its name (a \code{character} key), that is partially matched against the list of available algorithms: <>= # list all available algorithms nmfAlgorithm() # retrieve a specific algorithm: 'brunet' nmfAlgorithm('brunet') # partial match is also fine identical(nmfAlgorithm('br'), nmfAlgorithm('brunet')) @ \begin{table}[h!t] \begin{tabularx}{\textwidth}{lX} \hline Key & Description\\ \hline \code{brunet} & Standard NMF. Based on Kullback-Leibler divergence, it uses simple multiplicative updates from \cite{Lee2001}, enhanced to avoid numerical underflow. \begin{eqnarray} H_{kj} & \leftarrow & H_{kj} \frac{\left( \sum_l \frac{W_{lk} V_{lj}}{(WH)_{lj}} \right)}{ \sum_l W_{lk} }\\ W_{ik} & \leftarrow & W_{ik} \frac{ \sum_l [H_{kl} A_{il} / (WH)_{il} ] }{\sum_l H_{kl} } \end{eqnarray} \textbf{Reference:} \cite{Brunet2004}\\ \hline % \code{lee} & Standard NMF. Based on euclidean distance, it uses simple multiplicative updates \begin{eqnarray} H_{kj} & \leftarrow & H_{kj} \frac{(W^T V)_{kj}}{(W^T W H)_{kj}}\\ W_{ik} & \leftarrow & W_{ik} \frac{(V H^T)_{ik}}{(W H H^T)_{ik}} \end{eqnarray} \textbf{Reference:} \cite{Lee2001}\\ \hline % %\code{lnmf} & Local Nonnegative Matrix Factorization. Based on a %regularized Kullback-Leibler divergence, it uses a modified version of %Lee and Seung's multiplicative updates. % %\textbf{Reference:} \cite{Li2001}\\ % \code{nsNMF} & Non-smooth NMF. Uses a modified version of Lee and Seung's multiplicative updates for Kullback-Leibler divergence to fit a extension of the standard NMF model. It is meant to give sparser results. \textbf{Reference:} \cite{Pascual-Montano2006}\\ \hline % \code{offset} & Uses a modified version of Lee and Seung's multiplicative updates for euclidean distance, to fit a NMF model that includes an intercept. \textbf{Reference:} \cite{Badea2008}\\ \hline % \code{pe-nmf} & Pattern-Expression NMF. Uses multiplicative updates to minimize an objective function based on the Euclidean distance and regularized for effective expression of patterns with basis vectors. \textbf{Reference:} \cite{Zhang2008}\\ \hline % \code{snmf/r}, \code{snmf/l} & Alternating Least Square (ALS) approach. It is meant to be very fast compared to other approaches. \textbf{Reference:} \cite{KimH2007}\\ \hline \end{tabularx} \caption{Description of the implemented NMF algorithms. The first column gives the key to use in the call to the \texttt{nmf} function.\label{tab:algo}} \end{table} \subsection{Initialization: seeding methods} NMF algorithms need to be initialized with a seed (i.e. a value for $W_0$ and/or $H_0$\footnote{Some algorithms only need one matrix factor (either $W$ or $H$) to be initialized. See for example the SNMF/R(L) algorithm of Kim and Park \cite{KimH2007}.}), from which to start the iteration process. Because there is no global minimization algorithm, and due to the problem's high dimensionality, the choice of the initialization is in fact very important to ensure meaningful results. The more common seeding method is to use a random starting point, where the entries of $W$ and/or $H$ are drawn from a uniform distribution, usually within the same range as the target matrix's entries. This method is very simple to implement. However, a drawback is that to achieve stability one has to perform multiple runs, each with a different starting point. This significantly increases the computation time needed to obtain the desired factorization. To tackle this problem, some methods have been proposed so as to compute a reasonable starting point from the target matrix itself. Their objective is to produce deterministic algorithms that need to run only once, still giving meaningful results. For a review on some existing NMF initializations see \cite{Albright2006} and references therein. The \nmfpack\ package implements a number of already published seeding methods, and provides a general framework to implement other ones. \Cref{tab:seed} gives a short description of each one of the built-in seeding methods: The built-in seeding methods are listed or retrieved with function \code{nmfSeed}. A given seeding method is retrieved by its name (a \code{character} key) that is partially matched against the list of available seeding methods: <>= # list all available seeding methods nmfSeed() # retrieve a specific method: 'nndsvd' nmfSeed('nndsvd') # partial match is also fine identical(nmfSeed('nn'), nmfSeed('nndsvd')) @ \begin{table}[h!t] \begin{tabularx}{\textwidth}{lX} \hline Key & Description\\ \hline \code{ica} & Uses the result of an Independent Component Analysis (ICA) (from the \citeCRANpkg{fastICA}). Only the positive part of the result are used to initialize the factors.\\ \hline % \code{nnsvd} & 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 utilizing an algebraic property of unit rank matrices. It is well suited to initialize NMF algorithms with sparse factors. Simple practical variants of the algorithm allows to generate dense factors. \textbf{Reference:} \cite{Boutsidis2008}\\ \hline % \code{none} & Fix seed. This method allows the user to manually provide initial values for both matrix factors.\\ \hline % \code{random} & The entries of each factors are drawn from a uniform distribution over $[0, max(V)]$, where $V$ is the target matrix.\\ \hline \end{tabularx} \caption{Description of the implemented seeding methods to initialize NMF algorithms. The first column gives the key to use in the call to the \texttt{nmf} function.\label{tab:seed}} \end{table} \subsection{How to run NMF algorithms} Method \code{nmf} provides a single interface to run NMF algorithms. It can directly perform NMF on object of class \code{matrix} or \code{data.frame} and \code{ExpressionSet} -- if the \citeBioCpkg{Biobase} is installed. The interface has four main parameters: \medskip \fbox{\code{nmf(x, rank, method, seed, ...)}} \begin{description} \item[\code{x}] is the target \code{matrix}, \code{data.frame} or \code{ExpressionSet} \footnote{\code{ExpressionSet} is the base class for handling microarray data in BioConductor, and is defined in the \pkgname{Biobase} package.} \item[\code{rank}] is the factorization rank, i.e. the number of columns in matrix $W$. \item[\code{method}] is the algorithm used to estimate the factorization. The default algorithm is given by the package specific option \code{'default.algorithm'}, which defaults to \code{'brunet'} on installation \cite{Brunet2004}. \item[\code{seed}] is the seeding method used to compute the starting point. The default method is given by the package specific option \code{'default.seed'}, which defaults to \code{'random'} on initialization (see method \code{?rnmf} for details on its implementation). \end{description} See also \code{?nmf} for details on the interface and extra parameters. \subsection{Performances} Since version 0.4, some built-in algorithms are optimized in C++, which results in a significant speed-up and a more efficient memory management, especially on large scale data. The older R versions of the concerned algorithms are still available, and accessible by adding the prefix \code{'.R\#'} to the algorithms' access keys (e.g. the key \code{'.R\#offset'} corresponds to the R implementation of NMF with offset \cite{Badea2008}). Moreover they do not show up in the listing returned by the \code{nmfAlgorithm} function, unless argument \code{all=TRUE}: <>= nmfAlgorithm(all=TRUE) # to get all the algorithms that have a secondary R version nmfAlgorithm(version='R') @ \Cref{tab:perf} shows the speed-up achieved by the algorithms that benefit from the optimized code. All algorithms were run once with a factorization rank equal to 3, on the Golub data set which contains a $5000\times 38$ gene expression matrix. The same numeric random seed (\code{seed=123456}) was used for all factorizations. The columns \emph{C} and \emph{R} show the elapsed time (in seconds) achieved by the C++ version and R version respectively. The column \emph{Speed.up} contains the ratio $R/C$. <>= # retrieve all the methods that have a secondary R version meth <- nmfAlgorithm(version='R') meth <- c(names(meth), meth) meth # load the Golub data data(esGolub) # compute NMF for each method res <- nmf(esGolub, 3, meth, seed=123456) # extract only the elapsed time t <- sapply(res, runtime)[3,] @ <>= # speed-up m <- length(res)/2 su <- cbind( C=t[1:m], R=t[-(1:m)], Speed.up=t[-(1:m)]/t[1:m]) library(xtable) xtable(su, caption='Performance speed up achieved by the optimized C++ implementation for some of the NMF algorithms.', label='tab:perf') @ \subsection{How to cite the package NMF} To view all the package's bibtex citations, including all vignette(s) and manual(s): <>= # plain text citation('NMF') # or to get the bibtex entries toBibtex(citation('NMF')) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Use case: Golub dataset}\label{sec:usecase} We illustrate the functionalities and the usage of the \nmfpack package on the -- now standard -- Golub dataset on leukemia. It was used in several papers on NMF \cite{Brunet2004, Gao2005} and is included in the \nmfpack package's data, wrapped into an \code{ExpressionSet} object. For performance reason we use here only the first 200 genes. Therefore the results shown in the following are not meant to be biologically meaningful, but only illustrative: <>= data(esGolub) esGolub esGolub <- esGolub[1:200,] # remove the uneeded variable 'Sample' from the phenotypic data esGolub$Sample <- NULL @ % TODO: pass to 50 genes for dev \paragraph{Note:} To run this example, the \code{Biobase} package from BioConductor is required. \subsection{Single run}\label{sec:single_run} \subsubsection{Performing a single run} To run the default NMF algorithm on data \code{esGolub} with a factorization rank of 3, we call: <>= # default NMF algorithm res <- nmf(esGolub, 3) @ Here we did not specify either the algorithm or the seeding method, so that the computation is done using the default algorithm and is seeded by the default seeding methods. These defaults are set in the package specific options \code{'default.algorithm'} and \code{'default.seed'} respectively. See also \cref{sec:algo,sec:seed} for how to explicitly specify the algorithm and/or the seeding method. \subsubsection{Handling the result} The result of a single NMF run is an object of class \code{NMFfit}, that holds both the fitted NMF model and data about the run: <>= res @ The fitted model can be retrieved via method \code{fit}, which returns an object of class \code{NMF}: <>= fit(res) @ The estimated target matrix can be retrieved via the generic method \code{fitted}, which returns a -- generally big -- \code{matrix}: <>= V.hat <- fitted(res) dim(V.hat) @ Quality and performance measures about the factorization are computed by method \code{summary}: <>= summary(res) # More quality measures are computed, if the target matrix is provided: summary(res, target=esGolub) @ If there is some prior knowledge of classes present in the data, some other measures about the unsupervised clustering's performance are computed (purity, entropy, \ldots). Here we use the phenotypic variable \code{Cell} found in the Golub dataset, that gives the samples' cell-types (it is a factor with levels: T-cell, B-cell or \code{NA}): <>= summary(res, class=esGolub$Cell) @ The basis matrix (i.e. matrix $W$ or the metagenes) and the mixture coefficient matrix (i.e matrix $H$ or the metagene expression profiles) are retrieved using methods \code{basis} and \code{coef} respectively: <>= # get matrix W w <- basis(res) dim(w) # get matrix H h <- coef(res) dim(h) @ If one wants to keep only part of the factorization, one can directly subset on the \code{NMF} object on features and samples (separately or simultaneously). The result is a \code{NMF} object composed of the selected rows and/or columns: <>= # keep only the first 10 features res.subset <- res[1:10,] class(res.subset) dim(res.subset) # keep only the first 10 samples dim(res[,1:10]) # subset both features and samples: dim(res[1:20,1:10]) @ \subsubsection{Extracting metagene-specific features} In general NMF matrix factors are sparse, so that the metagenes can usually be characterized by a relatively small set of genes. Those are determined based on their relative contribution to each metagene. Kim and Park \cite{KimH2007} defined a procedure to extract the relevant genes for each metagene, based on a gene scoring schema. The NMF package implements this procedure in methods \code{featureScore} and \code{extractFeature}: <>= # only compute the scores s <- featureScore(res) summary(s) # compute the scores and characterize each metagene s <- extractFeatures(res) str(s) @ \subsection{Specifying the algorithm}\label{sec:algo} \subsubsection{Built-in algorithms} The \nmfpack package provides a number of built-in algorithms, that are listed or retrieved by function \code{nmfAlgorithm}. Each algorithm is identified by a unique name. The following algorithms are currently implemented (cf. \cref{tab:algo} for more details): <>= nmfAlgorithm() @ %\begin{tech} %Internally, all algorithms are stored in objects that inherit from class %\code{NMFStrategy}. This class defines the minimum interface %\end{tech} The algorithm used to compute the NMF is specified in the third argument (\code{method}). For example, to use the NMF algorithm from Lee and Seung \cite{Lee2001} based on the Frobenius euclidean norm, one make the following call: <>= # using Lee and Seung's algorithm res <- nmf(esGolub, 3, 'lee') algorithm(res) @ To use the Nonsmooth NMF algorithm from \cite{Pascual-Montano2006}: <>= # using the Nonsmooth NMF algorithm with parameter theta=0.7 res <- nmf(esGolub, 3, 'ns', theta=0.7) algorithm(res) fit(res) @ Or to use the PE-NMF algorithm from \cite{Zhang2008}: <>= # using the PE-NMF algorithm with parameters alpha=0.01, beta=1 res <- nmf(esGolub, 3, 'pe', alpha=0.01, beta=1) res @ %\begin{tech} %Although the last two calls looks similar these are handled % %In the case of the nsNMF algorithm, the fitted model is an object of class %\code{NMFns} that extends the standard NMF model \code{NMFstd}, as it introduces %a smoothing matrix $S$, parametrised by a real number $\theta \in [0,1]$, such %that the fitted model is: %$$ %V \approx W S(\theta) H. %$$ % %Hence the call to function \code{nmf}, parameter $\theta$ is used to % %\end{tech} \subsubsection{Custom algorithms} The \nmfpack package provides the user the possibility to define his own algorithms, and benefit from all the functionalities available in the NMF framework. There are only few contraints on the way the custom algorithm must be defined. See the details in \cref{sec:algo_custom}. \subsection{Specifying the seeding method}\label{sec:seed} The seeding method used to compute the starting point for the chosen algorithm can be set via argument \code{seed}. Note that if the seeding method is deterministic there is no need to perform multiple run anymore. \subsubsection{Built-in seeding methods} Similarly to the algorithms, the \code{nmfSeed} function can be used to list or retrieve the built-in seeding methods. The following seeding methods are currently implemented: <>= nmfSeed() @ To use a specific method to seed the computation of a factorization, one simply passes its name to \code{nmf}: <>= res <- nmf(esGolub, 3, seed='nndsvd') res @ \subsubsection{Numerical seed}\label{sec:numseed} Another possibility, useful when comparing methods or reproducing results, is to set the random number generator (RNG) by passing a numerical value in argument \code{seed}. This value is used to set the state of the RNG, and the initialization is performed by the built-in seeding method \code{'random'}. When the function \code{nmf} exits, the value of the random seed (\code{.Random.seed}) is restored to its original state -- as before the call. In the case of a single run (i.e. with \code{nrun=1}), the default is to use the current RNG, set with the R core function \code{set.seed}. In the case of multiple runs, the computations use RNGstream, as provided by the core RNG ``L'Ecuyer-CMRG" \cite{Lecuyer2002}, which generates multiple independent random streams (one per run). This ensures the complete reproducibility of any given set of runs, even when their computation is performed in parallel. Since RNGstream requires a 6-length numeric seed, a random one is generated if only a single numeric value is passed to \code{seed}. Moreover, single runs can also use RNGstream by passing a 6-length seed. <>= # single run and single numeric seed res <- nmf(esGolub, 3, seed=123456) showRNG(res) # multiple runs and single numeric seed res <- nmf(esGolub, 3, seed=123456, nrun=2) showRNG(res) # single run with a 6-length seed res <- nmf(esGolub, 3, seed=rep(123456, 6)) showRNG(res) @ \nbnote{To show the RNG changes happening during the computation use \texttt{.options='v4'} to turn on verbosity at level 4.\\ In versions prior 0.6, one could specify option \texttt{restore.seed=FALSE} or \texttt{'-r'}, this option is now deprecated.} \subsubsection{Fixed factorization} Yet another option is to completely specify the initial factorization, by passing values for matrices $W$ and $H$: <>= # initialize a "constant" factorization based on the target dimension init <- nmfModel(3, esGolub, W=0.5, H=0.3) head(basis(init)) # fit using this NMF model as a seed res <- nmf(esGolub, 3, seed=init) @ \subsubsection{Custom function} The \nmfpack package provides the user the possibility to define his own seeding method, and benefit from all the functionalities available in the NMF framework. There are only few contraints on the way the custom seeding method must be defined. See the details in \cref{sec:seed_custom}. \subsection{Multiple runs} When the seeding method is stochastic, multiple runs are usually required to achieve stability or a resonable result. This can be done by setting argument \code{nrun} to the desired value. For performance reason we use \code{nrun=5} here, but a typical choice would lies between 100 and 200: <>= res.multirun <- nmf(esGolub, 3, nrun=5) res.multirun @ By default, the returned object only contains the best fit over all the runs. That is the factorization that achieved the lowest approximation error (i.e. the lowest objective value). Even during the computation, only the current best factorization is kept in memory. This limits the memory requirement for performing multiple runs, which in turn allows to perform more runs. The object \code{res.multirun} is of class \code{NMFfitX1} that extends class \code{NMFfit}, the class returned by single NMF runs. It can therefore be handled as the result of a single run and benefit from all the methods defined for single run results. \medskip If one is interested in keeping the results from all the runs, one can set the option \code{keep.all=TRUE}: <>= # explicitly setting the option keep.all to TRUE res <- nmf(esGolub, 3, nrun=5, .options=list(keep.all=TRUE)) res @ <>= # or using letter code 'k' in argument .options nmf(esGolub, 3, nrun=5, .options='k') @ In this case, the result is an object of class \code{NMFfitXn} that also inherits from class \code{list}. Note that keeping all the results may be memory consuming. For example, a 3-rank \code{NMF} fit\footnote{i.e. the result of a single NMF run with rank equal 3.} for the Golub gene expression matrix ($5000 \times 38$) takes about \Sexpr{round(object.size(fit(res.multirun))/1000)}Kb\footnote{This size might change depending on the architecture (32 or 64 bits)}. \subsection{Parallel computations}\label{multicore} To speed-up the analysis whenever possible, the \nmfpack package implements transparent parallel computations when run on multi-core machines. It uses the \code{foreach} framework developed by REvolution Computing \citeCRANpkg{foreach}, together with the related \code{doParallel} parallel backend from the \citeCRANpkg{doParallel} -- based on the \pkgname{parallel} package -- to make use of all the CPUs available on the system, with each core simultaneously performing part of the runs. \subsubsection{Memory considerations} Running multicore computations increases the required memory linearly with the number of cores used. When only the best run is of interest, memory usage is optimized to only keep the current best factorization. On non-Windows machine, further speed improvement are achieved by using shared memory and mutex objects from the \citeCRANpkg{bigmemory} and the \citeCRANpkg{synchronicity}. \subsubsection{Parallel foreach backends} The default parallel backend used by the \code{nmf} function is defined by the package specific option \code{'pbackend'}, which defaults to \code{'par'} -- for \code{doParallel}. The backend can also be set on runtime via argument \code{.pbackend}. \medskip \paragraph{IMPORTANT NOTE:} The parallel computation is based on the \pkgname{doParallel} and \pkgname{parallel} packages, and the same care should be taken as stated in the vignette of the \citeCRANpkg{doMC}: \begin{quote} \emph{... it usually isn't safe to run doMC and multicore from a GUI environment. In particular, it is not safe to use doMC from R.app on Mac OS X. Instead, you should use doMC from a terminal session, starting R from the command line.} \end{quote} Therefore, the \code{nmf} function does not allow to run multicore computation from the MacOS X GUI. From version 0.8, other parallel backends are supported, and may be specified via argument \code{.pbackend}: \begin{description} \item[\code{.pbackend='mpi'}] uses the parallel backend \citeCRANpkg{doParallel} and \citeCRANpkg{doMPI} \item[\code{.pbackend=NULL}]{} \end{description} It is possible to specify that the currently registered backend should be used, by setting argument \code{.pbackend=NULL}. This allow to perform parallel computations with ``permanent'' backends that are configured externally of the \code{nmf} call. \subsubsection{Runtime options} There are two other runtime options, \code{parallel} and \code{parallel.required}, that can be passed via argument \code{.options}, to control the behaviour of the parallel computation (see below). \medskip A call for multiple runs will be computed in parallel if one of the following condition is satisfied: \begin{itemize} \item call with option \code{'P'} or \code{parallel.required} set to TRUE (note the upper case in \code{'P'}). In this case, if for any reason the computation cannot be run in parallel (packages requirements, OS, ...), then an error is thrown. Use this mode to force the parallel execution. \item call with option \code{'p'} or \code{parallel} set to TRUE. In this case if something prevents a parallel computation, the factorizations will be done sequentially. \item a valid parallel backend is specified in argument \code{.pbackend}. For the moment it can either be the string \code{'mc'} or a single \code{numeric} value specifying the number of core to use. Unless option \code{'P'} is specified, it will run using option \code{'p'} (i.e. try-parallel mode). \end{itemize} \nbnote{The number of processors to use can also be specified in the runtime options as e.g. \texttt{.options='p4'} or \texttt{.options='P4'} -- to ask or request 4 CPUs.} \paragraph{Examples}\ \\ The following exmaples are run with \code{.options='v'} which turn on verbosity at level 1, that will show which parallell setting is used by each computation. Although we do not show the output here, the user is recommended to run these commands on his machine to see the internal differences of each call. <>= # the default call will try to run in parallel using all the cores # => will be in parallel if all the requirements are satisfied nmf(esGolub, 3, nrun=5, .opt='v') # request a certain number of cores to use => no error if not possible nmf(esGolub, 3, nrun=5, .opt='vp8') # force parallel computation: use option 'P' nmf(esGolub, 3, nrun=5, .opt='vP') # require an improbable number of cores => error nmf(esGolub, 3, nrun=5, .opt='vP200') @ \subsubsection{High Performance Computing on a cluster} To achieve further speed-up, the computation can be run on an HPC cluster. In our tests we used the \citeCRANpkg{doMPI} to perform 100 factorizations using hybrid parallel computation on 4 quadri-core machines -- making use of all the cores computation on each machine. <>= # file: mpi.R ## 0. Create and register an MPI cluster library(doMPI) cl <- startMPIcluster() registerDoMPI(cl) library(NMF) # run on all workers using the current parallel backend data(esGolub) res <- nmf(esGolub, 3, 'brunet', nrun=n, .opt='p', .pbackend=NULL) # save result save(res, file='result.RData') ## 4. Shutdown the cluster and quit MPI closeCluster(cl) mpi.quit() @ Passing the following shell script to \emph{qsub} should launch the execution on a Sun Grid Engine HPC cluster, with OpenMPI. Some adaptation might be necessary for other queueing systems/installations. \begin{shaded} \small \begin{verbatim} #!/bin/bash #$ -cwd #$ -q opteron.q #$ -pe mpich_4cpu 16 echo "Got $NSLOTS slots. $TMP/machines" orterun -v -n $NSLOTS -hostfile $TMP/machines R --slave -f mpi.R \end{verbatim} \end{shaded} \subsubsection{Forcing sequential execution} When running on a single core machine, \nmfpack package has no other option than performing the multiple runs sequentially, one after another. This is done via the \code{sapply} function. On multi-core machine, one usually wants to perform the runs in parallel, as it speeds up the computation (cf. \cref{multicore}). However in some situation (e.g. while debugging), it might be useful to force the sequential execution of the runs. This can be done via the option \code{'p1'} to run on a single core , or with \code{.pbackend='seq'} to use the foreach backend \code{doSEQ} or to \code{NA} to use a standard \code{sapply} call: <>= # parallel execution on 2 cores (if possible) res1 <- nmf(esGolub, 3, nrun=5, .opt='vp2', seed=123) # or use the doParallel with single core res2 <- nmf(esGolub, 3, nrun=5, .opt='vp1', seed=123) # force sequential computation by sapply: use option '-p' or .pbackend=NA res3 <- nmf(esGolub, 3, nrun=5, .opt='v-p', seed=123) res4 <- nmf(esGolub, 3, nrun=5, .opt='v', .pbackend=NA, seed=123) # or use the SEQ backend of foreach: .pbackend='seq' res5 <- nmf(esGolub, 3, nrun=5, .opt='v', .pbackend='seq', seed=123) # all results are all identical nmf.equal(list(res1, res2, res3, res4, res5)) @ \subsection{Estimating the factorization rank} A critical parameter in NMF is the factorization rank $r$. It defines the number of metagenes used to approximate the target matrix. Given a NMF method and the target matrix, a common way of deciding on $r$ is to try different values, compute some quality measure of the results, and choose the best value according to this quality criteria. Several approaches have then been proposed to choose the optimal value of $r$. For example, \cite{Brunet2004} proposed to take the first value of $r$ for which the cophenetic coefficient starts decreasing, \cite{Hutchins2008} suggested to choose the first value where the RSS curve presents an inflection point, and \cite{Frigyesi2008} considered the smallest value at which the decrease in the RSS is lower than the decrease of the RSS obtained from random data. The \nmfpack package provides functions to help implement such procedures and plot the relevant quality measures. Note that this can be a lengthy computation, depending on the data size. Whereas the standard NMF procedure usually involves several hundreds of random initialization, performing 30-50 runs is considered sufficient to get a robust estimate of the factorization rank \cite{Brunet2004, Hutchins2008}. For performance reason, we perform here only 10 runs for each value of the rank. <>= # perform 10 runs for each value of r in range 2:6 estim.r <- nmf(esGolub, 2:6, nrun=10, seed=123456) @ The result is a S3 object of class \code{NMF.rank}, that contains a \code{data.frame} with the quality measures in column, and the values of $r$ in row. It also contains a list of the consensus matrix for each value of $r$. All the measures can be plotted at once with the method \code{plot} (\cref{fig:estim_all}), and the function \code{consensusmap} generates heatmaps of the consensus matrix for each value of the rank. In the context of class discovery, it is useful to see if the clusters obtained correspond to known classes. This is why in the particular case of the Golub dataset, we added annotation tracks for the two covariates available ('Cell' and 'ALL.AML'). Since we removed the variable 'Sample' in the preliminaries, these are the only variables in the phenotypic \code{data.frame} embedded within the \code{ExpressionSet} object, and we can simply pass the whole object to argument \code{annCol} (\cref{fig:estim_all_hm}). One can see that at rank 2, the clusters correspond to the ALL and AML samples respectively, while rank 3 separates AML from ALL/T-cell and ALL/B-cell\footnote{Remember that the plots shown in \cref{fig:estim_all_hm} come from only 10 runs, using the 200 first genes in the dataset, which explains the somewhat not so clean clusters. The results are in fact much cleaner when using the full dataset (\cref{fig:heatmap_consensus}).}. \begin{figure} <>= plot(estim.r) @ \caption{Estimation of the rank: Quality measures computed from 10 runs for each value of $r$. \label{fig:estim_all}} \end{figure} \begin{figure} <>= consensusmap(estim.r, annCol=esGolub, labCol=NA, labRow=NA) @ \caption{Estimation of the rank: Consensus matrices computed from 10 runs for each value of $r$. \label{fig:estim_all_hm}} \end{figure} \subsubsection{Overfitting} Even on random data, increasing the factorization rank would lead to decreasing residuals, as more variables are available to better fit the data. In other words, there is potentially an overfitting problem. In this context, the approach from \cite{Frigyesi2008} may be useful to prevent or detect overfitting as it takes into account the results for unstructured data. However it requires to compute the quality measure(s) for the random data. The \nmfpack package provides a function that shuffles the original data, by permuting the rows of each column, using each time a different permutation. The rank estimation procedure can then be applied to the randomized data, and the ``random'' measures added to the plot for comparison (\cref{fig:estim_all_rd}). \begin{figure} <>= # shuffle original data V.random <- randomize(esGolub) # estimate quality measures from the shuffled data (use default NMF algorithm) estim.r.random <- nmf(V.random, 2:6, nrun=10, seed=123456) # plot measures on same graph plot(estim.r, estim.r.random) @ \caption{Estimation of the rank: Comparison of the quality measures with those obtained from randomized data. The curves for the actual data are in blue and green, those for the randomized data are in red and pink. The estimation is based on Brunet's algorithm.} \label{fig:estim_all_rd} \end{figure} \subsection{Comparing algorithms} To compare the results from different algorithms, one can pass a list of methods in argument \code{method}. To enable a fair comparison, a deterministic seeding method should also be used. Here we fix the random seed to 123456. <>= # fit a model for several different methods res.multi.method <- nmf(esGolub, 3, list('brunet', 'lee', 'ns'), seed=123456, .options='t') @ Passing the result to method \code{compare} produces a \code{data.frame} that contains summary measures for each method. Again, prior knowledge of classes may be used to compute clustering quality measures: <>= compare(res.multi.method) # If prior knowledge of classes is available compare(res.multi.method, class=esGolub$Cell) @ Because the computation was performed with error tracking enabled, an error plot can be produced by method \code{plot} (\cref{fig:errorplot}). Each track is normalized so that its first value equals one, and stops at the iteration where the method's convergence criterion was fulfilled. \subsection{Visualization methods} \subsubsection*{Error track} If the NMF computation is performed with error tracking enabled -- using argument \code{.options} -- the trajectory of the objective value is computed during the fit. This computation is not enabled by default as it induces some overhead. <>= # run nmf with .option='t' res <- nmf(esGolub, 3, .options='t') # or with .options=list(track=TRUE) @ The trajectory can be plot with the method \code{plot} (\cref{fig:errorplot}): \begin{figure}[!htbp] <>= plot(res) plot(res.multi.method) @ \caption{Error track for a single NMF run (left) and multiple method runs (right)} \label{fig:errorplot} \end{figure} \subsubsection*{Heatmaps} The methods \code{basismap}, \code{coefmap} and \code{consensusmap} provide an easy way to visualize respectively the resulting basis matrix (i.e. metagenes), mixture coefficient matrix (i.e. metaprofiles) and the consensus matrix, in the case of multiple runs. It produces pre-configured heatmaps based on the function \code{aheatmap}, the underlying heatmap engine provided with the package NMF. The default heatmaps produced by these functions are shown in \cref{fig:heatmap_coef_basis,fig:heatmap_consensus}. They can be customized in many different ways (colours, annotations, labels). See the dedicated vignette \emph{``NMF: generating heatmaps"} or the help pages \code{?coefmap} and \code{?aheatmap} for more information. An important and unique feature of the function \code{aheatmap}, is that it makes it possible to combine several heatmaps on the same plot, using the both standard layout calls \texttt{par(mfrow=...)} and \texttt{layout(...)}, or grid viewports from \texttt{grid} graphics. The plotting context is automatically internally detected, and a correct behaviour is achieved thanks to the \citeCRANpkg{gridBase}. Examples are provided in the dedicated vignette mentioned above. The rows of the basis matrix often carry the high dimensionality of the data: genes, loci, pixels, features, etc\ldots The function \code{basismap} extends the use of argument \code{subsetRow} (from \code{aheatmap}) to the specification of a feature selection method. In \cref{fig:heatmap_coef_basis} we simply used \code{subsetRow=TRUE}, which subsets the rows using the method described in \cite{KimH2007}, to only keep the basis-specific features (e.g. the metagene-specific genes). We refer to the relevant help pages \code{?basismap} and \code{?aheatmap} for more details about other possible values for this argument. \begin{figure}[!htbp] \centering <>= layout(cbind(1,2)) # basis components basismap(res, subsetRow=TRUE) # mixture coefficients coefmap(res) @ \caption{Heatmap of the basis and the mixture coefficient matrices. The rows of the basis matrix were selected using the default feature selection method -- described in \cite{KimH2007}.} \label{fig:heatmap_coef_basis} \end{figure} In the case of multiple runs the function \code{consensusmap} plots the consensus matrix, i.e. the average connectivity matrix across the runs (see results in \cref{fig:heatmap_consensus} for a consensus matrix obtained with 100 runs of Brunet's algorithm on the complete Golub dataset): \begin{figure}[ht] <>= # The cell type is used to label rows and columns consensusmap(res.multirun, annCol=esGolub, tracks=NA) plot(1:10) f2 <- fig_path("2.pdf") @ <>= file.copy('consensus.pdf', f2, overwrite=TRUE) @ \caption{Heatmap of consensus matrices from 10 runs on the reduced dataset (left) and from 100 runs on the complete Golub dataset (right).} \label{fig:heatmap_consensus} \end{figure} \section{Extending the package} We developed the \nmfpack\ package with the objective to facilitate the integration of new NMF methods, trying to impose only few requirements on their implementations. All the built-in algorithms and seeding methods are implemented as strategies that are called from within the main interface method \code{nmf}. The user can define new strategies and those are handled in exactly the same way as the built-in ones, benefiting from the same utility functions to interpret the results and assess their performance. \subsection{Custom algorithm} %New NMF algrithms can be defined in two ways: % %\begin{itemize} %\item as a single \code{function} %\item as a set of functions that implement a pre-defined \emph{iterative schema} %\end{itemize} % %\subsubsection{Defined as a \code{function}} \subsubsection{Using a custom algorithm}\label{sec:algo_custom} To define a strategy, the user needs to provide a \code{function} that implements the complete algotihm. It must be of the form: <>= my.algorithm <- function(x, seed, param.1, param.2){ # do something with starting point # ... # return updated starting point return(seed) } @ Where: \begin{description} \item[target] is a \code{matrix}; \item[start] is an object that inherits from class \code{NMF}. This \code{S4} class is used to handle NMF models (matrices \code{W} and \code{H}, objective function, etc\dots); \item[param.1, param.2] are extra parameters specific to the algorithms; \end{description} The function must return an object that inherits from class \code{NMF}. For example: <>= my.algorithm <- function(x, seed, scale.factor=1){ # do something with starting point # ... # for example: # 1. compute principal components pca <- prcomp(t(x), retx=TRUE) # 2. use the absolute values of the first PCs for the metagenes # Note: the factorization rank is stored in object 'start' factorization.rank <- nbasis(seed) basis(seed) <- abs(pca$rotation[,1:factorization.rank]) # use the rotated matrix to get the mixture coefficient # use a scaling factor (just to illustrate the use of extra parameters) coef(seed) <- t(abs(pca$x[,1:factorization.rank])) / scale.factor # return updated data return(seed) } @ To use the new method within the package framework, one pass \code{my.algorithm} to main interface \code{nmf} via argument \code{method}. Here we apply the algorithm to some matrix \code{V} randomly generated: <>= n <- 50; r <- 3; p <- 20 V <-syntheticNMF(n, r, p) @ <>= nmf(V, 3, my.algorithm, scale.factor=10) @ \subsubsection{Using a custom distance measure} The default distance measure is based on the euclidean distance. If the algorithm is based on another distance measure, this one can be specified in argument \code{objective}, either as a \code{character} string corresponding to a built-in objective function, or a custom \code{function} definition\footnote{Note that from version 0.8, the arguments for custom objective functions have been swapped: (1) the current NMF model, (2) the target matrix}: <>= # based on Kullback-Leibler divergence nmf(V, 3, my.algorithm, scale.factor=10, objective='KL') # based on custom distance metric nmf(V, 3, my.algorithm, scale.factor=10 , objective=function(model, target, ...){ ( sum( (target-fitted(model))^4 ) )^{1/4} } ) @ %\subsubsection{Using the iterative schema} % %NMF algorithms generally implement the following common iterative schema: % %\begin{enumerate} %\item %\item %\end{enumerate} \subsubsection{Defining algorithms for mixed sign data} All the algorithms implemented in the \nmfpack package assume that the input data is nonnegative. However, some methods exist in the litterature that work with relaxed constraints, where the input data and one of the matrix factors ($W$ or $H$) are allowed to have negative entries (eg. semi-NMF \cite{Ding2010, Roux2008}). Strictly speaking these methods do not fall into the NMF category, but still solve constrained matrix factorization problems, and could be considered as NMF methods when applied to non-negative data. Moreover, we received user requests to enable the development of semi-NMF type methods within the package's framework. Therefore, we designed the \nmfpack package so that such algorithms -- that handle negative data -- can be integrated. This section documents how to do it. By default, as a safe-guard, the sign of the input data is checked before running any method, so that the \code{nmf} function throws an error if applied to data that contain negative entries \footnote{Note that on the other side, the sign of the factors returned by the algorithms is never checked, so that one can always return factors with negative entries.}. To extend the capabilities of the \nmfpack package in handling negative data, and plug mixed sign NMF methods into the framework, the user needs to specify the argument \code{mixed=TRUE} in the call to the \code{nmf} function. This will skip the sign check of the input data and let the custom algorithm perform the factorization. As an example, we reuse the previously defined custom algorithm\footnote{As it is defined here, the custom algorithm still returns nonnegative factors, which would not be desirable in a real example, as one would not be able to closely fit the negative entries.}: <>= # put some negative input data V.neg <- V; V.neg[1,] <- -1; # this generates an error try( nmf(V.neg, 3, my.algorithm, scale.factor=10) ) # this runs my.algorithm without error nmf(V.neg, 3, my.algorithm, mixed=TRUE, scale.factor=10) @ \subsubsection{Specifying the NMF model} If not specified in the call, the NMF model that is used is the standard one, as defined in \cref{NMFstd}. However, some NMF algorithms have different underlying models, such as non-smooth NMF \cite{Pascual-Montano2006} which uses an extra matrix factor that introduces an extra parameter, and change the way the target matrix is approximated. The NMF models are defined as S4 classes that extends class \code{NMF}. All the available models can be retreived calling the \code{nmfModel()} function with no argument: <>= nmfModel() @ One can specify the NMF model to use with a custom algorithm, using argument \code{model}. Here we first adapt a bit the custom algorithm, to justify and illustrate the use of a different model. We use model \code{NMFOffset} \cite{Badea2008}, that includes an offset to take into account genes that have constant expression levels accross the samples: <>= my.algorithm.offset <- function(x, seed, scale.factor=1){ # do something with starting point # ... # for example: # 1. compute principal components pca <- prcomp(t(x), retx=TRUE) # retrieve the model being estimated data.model <- fit(seed) # 2. use the absolute values of the first PCs for the metagenes # Note: the factorization rank is stored in object 'start' factorization.rank <- nbasis(data.model) basis(data.model) <- abs(pca$rotation[,1:factorization.rank]) # use the rotated matrix to get the mixture coefficient # use a scaling factor (just to illustrate the use of extra parameters) coef(data.model) <- t(abs(pca$x[,1:factorization.rank])) / scale.factor # 3. Compute the offset as the mean expression data.model@offset <- rowMeans(x) # return updated data fit(seed) <- data.model seed } @ Then run the algorithm specifying it needs model \code{NMFOffset}: <>= # run custom algorithm with NMF model with offset nmf(V, 3, my.algorithm.offset, model='NMFOffset', scale.factor=10) @ \subsection{Custom seeding method}\label{sec:seed_custom} The user can also define custom seeding method as a function of the form: <>= # start: object of class NMF # target: the target matrix my.seeding.method <- function(model, target){ # use only the largest columns for W w.cols <- apply(target, 2, function(x) sqrt(sum(x^2))) basis(model) <- target[,order(w.cols)[1:nbasis(model)]] # initialize H randomly coef(model) <- matrix(runif(nbasis(model)*ncol(target)) , nbasis(model), ncol(target)) # return updated object return(model) } @ To use the new seeding method: <>= nmf(V, 3, 'snmf/r', seed=my.seeding.method) @ \section{Advanced usage} \subsection{Package specific options} The package specific options can be retieved or changed using the \code{nmf.getOption} and \code{nmf.options} functions. These behave similarly as the \code{getOption} and \code{nmf.options} base functions: <>= #show default algorithm and seeding method nmf.options('default.algorithm', 'default.seed') # retrieve a single option nmf.getOption('default.seed') # All options nmf.options() @ Currently the following options are available: <>= RdSection2latex('nmf.options', package='NMF') @ The default/current values of each options can be displayed using the function \code{nmf.printOptions}: <>= nmf.printOptions() @ %% latex table generated in R 2.10.1 by xtable 1.5-6 package %% Wed Apr 7 15:27:05 2010 %\begin{table}[ht] %\begin{center} %\begin{tabularx}{\textwidth}{>{\ttfamily}rlX} % \hline %Option & Default value & Description\\ %\hline %default.algorithm & brunet & Default NMF algorithm used by the \code{nmf} function when argument \code{method} is missing. %The value should the key of one of the available NMF algorithms. %See \code{?nmfAlgorithm}.\\ %track.interval & 30 & Number of iterations between two points in the residual track. %This option is relevant only when residual tracking is enabled. %See \code{?nmf}.\\ %error.track & FALSE & Toggle default residual tracking. %When \code{TRUE}, the \code{nmf} function compute and store the residual track in the result -- if not otherwise specified in argument \code{.options}. %Note that tracking may significantly slow down the computations.\\ %default.seed & random & Default seeding method used by the \code{nmf} function when argument \code{seed} is missing. %The value should the key of one of the available seeding methods. %See \code{?nmfSeed}.\\ %backend & mc & Default parallel backend used used by the \code{nmf} function when argument \code{.pbackend} is missing. %Currently the following values are supported: \code{'mc'} for multicore, \code{'seq'} for sequential, \code{''} for \code{sapply}.\\ %verbose & FALSE & Toggle verbosity.\\ %debug & FALSE & Toggle debug mode, which is an extended verbose mode.\\ %\hline %\end{tabularx} %\end{center} %\caption{} %\end{table} \pagebreak \section{Session Info} <>= toLatex(sessionInfo()) @ \printbibliography[heading=bibintoc] \end{document} NMF/inst/doc/heatmaps.R0000644000176000001440000000765412311534443014405 0ustar ripleyusers ## ----pkgmaker_preamble, echo=FALSE, results='asis'----------------------- pkgmaker::latex_preamble() ## ----bibliofile, echo=FALSE, results='asis'------------------------------ pkgmaker::latex_bibliography('NMF') ## ----options, include=FALSE, verbose=TRUE-------------------------------- #options(prompt=' ') #options(continue=' ') set.seed(123456) library(NMF) ## ----data---------------------------------------------------------------- # random data that follow an 3-rank NMF model (with quite some noise: sd=2) X <- syntheticNMF(100, 3, 20, noise=2) # row annotations and covariates n <- nrow(X) d <- rnorm(n) e <- unlist(mapply(rep, c('X', 'Y', 'Z'), 10)) e <- c(e, rep(NA, n-length(e))) rdata <- data.frame(Var=d, Type=e) # column annotations and covariates p <- ncol(X) a <- sample(c('alpha', 'beta', 'gamma'), p, replace=TRUE) # define covariates: true groups and some numeric variable c <- rnorm(p) # gather them in a data.frame covariates <- data.frame(a, X$pData, c) ## ----figoptions, include=FALSE------------------------------------------- library(knitr) opts_chunk$set(fig.width=14, fig.height=7) ## ----heatmap_data-------------------------------------------------------- par(mfrow=c(1,2)) aheatmap(X, annCol=covariates, annRow=X$fData) aheatmap(X) ## ----model, cache=TRUE--------------------------------------------------- res <- nmf(X, 3, nrun=10) res ## ----coefmap_res, fig.keep='last'---------------------------------------- opar <- par(mfrow=c(1,2)) # coefmap from multiple run fit: includes a consensus track coefmap(res) # coefmap of a single run fit: no consensus track coefmap(minfit(res)) par(opar) ## ----coefmap_default, eval=FALSE----------------------------------------- ## Rowv = NA ## Colv = TRUE ## scale = 'c1' ## color = 'YlOrRd:50' ## annCol = predict(object) + predict(object, 'consensus') ## ----coefmap_custom, fig.keep='last', tidy=FALSE------------------------- opar <- par(mfrow=c(1,2)) # removing all automatic annotation tracks coefmap(res, tracks=NA) # customized plot coefmap(res, Colv = 'euclidean' , main = "Metagene contributions in each sample", labCol = NULL , annRow = list(Metagene=':basis'), annCol = list(':basis', Class=a, Index=c) , annColors = list(Metagene='Set2') , info = TRUE) par(opar) ## ----basismap_res, fig.keep='last'--------------------------------------- opar <- par(mfrow=c(1,2)) # default plot basismap(res) # customized plot: only use row special annotation track. basismap(res, main="Metagenes", annRow=list(d, e), tracks=c(Metagene=':basis')) par(opar) ## ----basismap_default, eval=FALSE---------------------------------------- ## Colv = NA ## scale = 'r1' ## color = 'YlOrRd:50' ## annRow = predict(object, 'features') ## ----consensusmap_res, fig.keep='last'----------------------------------- opar <- par(mfrow=c(1,2)) # default plot consensusmap(res) # customized plot consensusmap(res, annCol=covariates, annColors=list(c='blue') , labCol='sample ', main='Cluster stability' , sub='Consensus matrix and all covariates') par(opar) ## ----cmap_default, eval=FALSE-------------------------------------------- ## distfun = function(x) as.dist(1-x) # x being the consensus matrix ## hclustfun = 'average' ## Rowv = TRUE ## Colv = "Rowv" ## color = '-RdYlBu' ## ----estimate, cache=TRUE------------------------------------------------ res2_7 <- nmf(X, 2:7, nrun=10, .options='v') class(res2_7) ## ----consensusmap_estimate, fig.keep='last'------------------------------ consensusmap(res2_7) ## ----fit_methods, cache=TRUE--------------------------------------------- res_methods <- nmf(X, 3, list('lee', 'brunet', 'nsNMF'), nrun=10) class(res_methods) ## ----consensusmap_methods, fig.width=10, fig.height=7, fig.keep='last'---- consensusmap(res_methods) ## ----demo_hm, eval=FALSE------------------------------------------------- ## demo('aheatmap') ## # or ## demo('heatmaps') ## ----sessionInfo, echo=FALSE, results='asis'----------------------------- toLatex(sessionInfo()) NMF/inst/m-files/0000755000176000001440000000000012307573611013240 5ustar ripleyusersNMF/inst/m-files/brunet.R0000644000176000001440000000774312234465004014670 0ustar ripleyusers####################################################################### # # Script to compare the results/performances from the NMF package # and the original MATLAB implementation of the algorithm from Brunet et al.. # # This is for when the RcppOctave package is not available, which # makes things much manual... # ####################################################################### cat("\n# START\n") # auxiliary function to save data in a plain text format save.ascii <- function(X, file){ X <- format(X, digits=11) write.table(X, file=file, row.names=FALSE, col.names=FALSE, quote=FALSE) invisible() } #load NMF library(NMF) ################################################## # STEP 1: Generate the test data ################################################## # load the target: the Golub data cat("* Prepare data:\n") cat("\t- Load Golub data\n") data(esGolub) target <- exprs(esGolub) n <- nrow(target) p <- ncol(target) rank <- 3 # save target cat("\t- Save Golub data in ASCII\n") save.ascii(target, 'target.txt') # set the seed for reproducibility set.seed(654321) # generate and save W cat("\t- Generate initial value for W\n") save.ascii(matrix(runif(n*rank), n, rank), 'W.txt') # generate and save H cat("\t- Generate initial value for H\n") save.ascii(matrix(runif(rank*p), rank, p), 'H.txt') ########################################################### # STEP 2: Run Brunet et al. algorithm using the NMF package ########################################################### # load the test data cat("\n* Reload the generated data\n") target <- as.matrix(read.table('target.txt')) W0 <- as.matrix(read.table('W.txt')) H0 <- as.matrix(read.table('H.txt')) # wrap the seed into a NMF object start <- nmfModel(W=W0, H=H0) # apply Brunet algorithm cat("* NMF package: run Brunet [optim]\n") res <- nmf(target, method='brunet', seed=start) # optimized in C++ cat("* NMF package: run Brunet [plain]\n") res.R <- nmf(target, method='.R#brunet', seed=start) # plain R ###################################################################### # STEP 3: Switch to MATLAB/GNU Octave and run Brunet et al. algorithm # using the orginal MATLAB code ###################################################################### # We adapted the original MATLAB code obtained to be able to specify # initial values for the matrices W and H. # Original MATLAB code: http://www.broadinstitute.org/mpr/publications/projects/NMF/nmf.m # Adapted algorithm: m-files/brunet.m # MATLAB code to run the test factorization: m-files/brunet-run.m # # The results should be saved in a single file named 'ref.brunet.oct' #, that contains the final values for W and H, in variables named 'W' and 'H'. ################################################################### # STEP 4: Compare the results ################################################################### # load the results obtained with the MATLAB code (from Brunet et al. publication) cat("* Load results from MATLAB/Octave\n") if( !file.exists('ref.brunet.oct') ) stop("Could not find file 'ref.brunet.oct'. [Please run the script 'brunet-run.m' to generate it]") library(foreign) ref <- read.octave('ref.brunet.oct') ## Note: we used GNU Octave to run the MATLAB code, ## if the result was obtained using MATLAB, then the following code should load ## it correctly (we did not test it though). #library(R.matlab) #ref <- readMat('ref.brunet.mat') cat("* Comparison of results:\n\n") #Sum of differences in W cat("\t- Sum of absolute differences in W: ", sum( abs(basis(res) -ref$W) ), "\n") cat("\t [all.equal = ", all.equal(basis(res), ref$W, check.attributes=FALSE), "]\n") #Sum of differences in H cat("\t- Sum of absolute differences in H: ", sum( abs(coef(res) - ref$H) ), "\n") cat("\t [all.equal = ", all.equal(coef(res), ref$H, check.attributes=FALSE), "]\n") # compare performances cat("\t- Speed comparaison: \n") t.ref <- unlist(ref[c('user', 'sys', 'elapsed')]) rbind(`R optim` = runtime(res)[1:3], `MATLAB/Octave`=t.ref, `R plain`=runtime(res.R)[1:3]) cat("\n# DONE\n") NMF/inst/m-files/brunet-run.m0000644000176000001440000000216212234465004015513 0ustar ripleyusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % MATLAB/Octave code to run NMF using Brunet et al. original algorithm % (see in file brunet.m). % The objective is to be able to compare the results/performances from the % NMF package and the original MATLAB code. % % The original function 'nmf' was adapted to accept arguments to set the initial % values for the matrix factors W and H. % % Original MATLAB codes can be found at: % http://www.broadinstitute.org/mpr/publications/projects/NMF/nmf.m % http://www.broadinstitute.org/publications/broad872 % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % clean workspace clear -all; % load Brunet et al. algorithm -> defines the 'nmf' function source('brunet.m'); % load test data target = load('target.txt'); W0 = load('W.txt'); H0 = load('H.txt'); [n, rank] = size(W0); % run algorithm [total, user, sys] = cputime(); [W,H] = nmf(target, rank, false, W0, H0); [total2, user2, sys2] = cputime(); elapsed = total2 - total; user = user2 - user; sys = sys2 - sys; % save result save 'ref.brunet.oct' W H elapsed user sys; NMF/inst/m-files/brunet.m0000644000176000001440000001306312305630424014712 0ustar ripleyusers% NMF algorithm using the update equations for the Kullback-Leibler divergence % from Lee and Seung (2001), implemented in MATLAB by Brunet et al. (2004). % % USAGE: [w, h, elapsed, user, sys, niter] = brunet(v, r, verbose, w, h) % % ARGUMENTS: % % v (n,m) : N (genes) x M (samples) original matrix % Numerical data only. % Must be non negative. % Not all entries in a row can be 0. If so, add a small constant to the % matrix, eg.v+0.01*min(min(v)),and restart. % % r : number of desired factors (rank of the factorization) % % verbose : prints iteration count and changes in connectivity matrix elements % unless verbose is 0 % % OPTIONAL ARGUMENTS: % % w : N (genes) x r matrix to used to seed the computation % h : r x M (samples) matrix to used to seed the computation % % Note : both matrices w and h must be supplied to effectively seed the % computation. Otherwise the original random initialization of both is % used. % % Note : NMF iterations stop when connectivity matrix has not changed % for 10*stopconv interations. This is experimental and can be % adjusted. % % RETURNED VALUE(S): % % w : N x r NMF factor % h : r x M NMF factor % elapsed : Elapsed wallclock time % user : Elapsed user time % sys : Elapsed system time % niter : Number of iterations used % % DETAILS: % % The original MATLAB/Octave code for NMF is from Brunet et al. % % It was slightly adapted for the purpose of the development of the % NMF package (http://cran.r-project.org/package=NMF) % Modifications include: % - renaming of the function from `nmf` to `brunet` % - add arguments to allow setting the initial values for the matrix % factors W and H % - compute and return CPU timing % % Modifications in the original code are signaled with tags RG, RG_START and RG_END. % % REFERENCES % % Lee, D..D., and Seung, H.S. (2001). % 'Algorithms for Non-negative Matrix Factorization'. % Adv. Neural Info. Proc. Syst. 13, 556-562. % % Brunet, J.P. et al. (2004). % 'Metagenes and molecular pattern discovery using matrix factorization'. % Proc Natl Acad Sci U S A, \bold{101}(12), 4164--4169. % % Original MATLAB files can be found at: % http://www.broadinstitute.org/mpr/publications/projects/NMF/nmf.m % http://www.broadinstitute.org/publications/broad872 % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% function [W,H,runtime,niter] = brunet(v,r,verbose, w, h, niter) % % Jean-Philippe Brunet % Cancer Genomics % The Broad Institute % brunet@broad.mit.edu % % This software and its documentation are copyright 2004 by the % Broad Institute/Massachusetts Institute of Technology. All rights are reserved. % This software is supplied without any warranty or guaranteed support whatsoever. % Neither the Broad Institute nor MIT can not be responsible for its use, misuse, % or functionality. % % NMF divergence update equations : % Lee, D..D., and Seung, H.S., (2001), 'Algorithms for Non-negative Matrix % Factorization', Adv. Neural Info. Proc. Syst. 13, 556-562. % % v (n,m) : N (genes) x M (samples) original matrix % Numerical data only. % Must be non negative. % Not all entries in a row can be 0. If so, add a small constant to the % matrix, eg.v+0.01*min(min(v)),and restart. % % r : number of desired factors (rank of the factorization) % % verbose : prints iteration count and changes in connectivity matrix elements % unless verbose is 0 % % Note : NMF iterations stop when connectivity matrix has not changed % for 10*stopconv interations. This is experimental and can be % adjusted. % % w : N x r NMF factor % h : r x M NMF factor % test for negative values in v if min(min(v)) < 0 error('matrix entries can not be negative'); return end if min(sum(v,2)) == 0 error('not all entries in a row can be zero'); return end [n,m]=size(v); stopconv=40; % stopping criterion (can be adjusted) if nargin<6, niter = 2000; % maximum number of iterations (can be adjusted) end cons=zeros(m,m); consold=cons; inc=0; j=0; %% RG_START: Modified by Renaud Gaujoux (2009) % % initialize random w and h (only if one of the factor is missing) % if nargin<5, if( verbose ) fprintf('Use random W and H\n'); end w=rand(n,r); h=rand(r,m); end %% RG_END [total, user, sys] = cputime(); % [RG] Add CPU timing if verbose % prints number of changing elements fprintf('\t%s\t%s\t%s\n','niter','citer','changes'), end for i=1:niter % divergence-reducing NMF iterations x1=repmat(sum(w,1)',1,m); h=h.*(w'*(v./(w*h)))./x1; x2=repmat(sum(h,2)',n,1); w=w.*((v./(w*h))*h')./x2; % test convergence every 10 iterations if(mod(i,10)==0) j=j+1; % adjust small values to avoid undeflow h=max(h,eps);w=max(w,eps); % construct connectivity matrix [y,index]=max(h,[],1); %find largest factor mat1=repmat(index,m,1); % spread index down mat2=repmat(index',1,m); % spread index right cons=mat1==mat2; if(sum(sum(cons~=consold))==0) % connectivity matrix has not changed inc=inc+1; %accumulate count else inc=0; % else restart count end if verbose % prints number of changing elements fprintf('\t%d\t%d\t%d\n',i,inc,sum(sum(cons~=consold))), end if(inc>stopconv) break, % assume convergence is connectivity stops changing end consold=cons; end end % [RG_START] Compute CPU time [total2, user2, sys2] = cputime(); runtime.user = user2 - user; runtime.sys = sys2 - sys; runtime.elapsed = total2 - total; niter = i; W = w; H = h; % [RG_END] NMF/tests/0000755000176000001440000000000012310572713012065 5ustar ripleyusersNMF/tests/doRUnit.R0000644000176000001440000000314512310572713013577 0ustar ripleyusers# Run all unit tests in installed directory unitTests # # Author: Renaud Gaujoux # Creation: 26 Oct 2011 ############################################################################### library(pkgmaker) # Skip checks except if run locally if( !isFALSE(Sys.getenv_value('_R_LOCAL_CHECK_')) ){ # skip tests on CRAN checks #if( !isCRANcheck() ){ library(NMF) library(RUnit) nmf.options(maxIter=100L) tests <- try( utest('package:NMF', quiet=FALSE) ) if( FALSE ){ testdir <- pkgmaker:::utestPath(package='package:NMF') resfile <- list.files(testdir, pattern=".+\\.txt", full.names=TRUE) cat("Result files:\n") print(resfile) if( length(resfile) ){ # send library(mail) sapply(resfile, function(f){ # build message msg <- c("**************\nR.version Info\n**************\n", capture.output(R.version)) sys <- Sys.info() msg <- c(msg, "**************\nSystem Info\n**************\n" , sapply(names(sys), function(n){ paste(n, ': ', sys[n], sep='')})) msg <- c(msg, "**************\nRESULTS:\n**************\n", readLines(f)) # collapse msg <- paste(msg, collapse="\n") # subject subject <- paste("Package NMF: unit test results" , "-", basename(f), "-" , "[", if( is(tests, 'try-error') ) 'ERROR' else "OK", "]" , sep='') if( isCRANcheck() ){ subject <- paste('CRAN check -', subject) } # try send email if( !userIs('renaud') ) try( sendmail('renaud@cbio.uct.ac.za', subject, msg) ) else write(msg, file=file.path(testdir, paste("check_", basename(f), sep=''))) }) } } # end if NOT CRAN check # stop if error if( is(tests, 'try-error') ){ stop(tests) } } NMF/src/0000755000176000001440000000000012530712567011521 5ustar ripleyusersNMF/src/divergence.cpp0000644000176000001440000001365612530712567014353 0ustar ripleyusers#ifndef NMF_DIVERGENCE_H // include header only once #define NMF_DIVERGENCE_H #include #include #include extern "C" { SEXP divergence_update_H ( SEXP v, SEXP w, SEXP h, SEXP nbterms, SEXP ncterms, SEXP dup); SEXP divergence_update_W ( SEXP v, SEXP w, SEXP h, SEXP nbterms, SEXP ncterms, SEXP dup); } // include version for both double/integer storage.mode (defined as templates) #include "divergence.cpp" // define the exported versions (for SEXP) SEXP divergence_update_H ( SEXP v, SEXP w, SEXP h , SEXP nbterms=ScalarInteger(0), SEXP ncterms=ScalarInteger(0) , SEXP dup=ScalarLogical(1)) { if( TYPEOF(v) == REALSXP ){ return divergence_update_H(NUMERIC_POINTER(v), w, h , *INTEGER(nbterms), *INTEGER(ncterms) , *LOGICAL(dup)); }else{ return divergence_update_H(INTEGER_POINTER(v), w, h , *INTEGER(nbterms), *INTEGER(ncterms) , *LOGICAL(dup)); } } SEXP divergence_update_W ( SEXP v, SEXP w, SEXP h , SEXP nbterms=ScalarInteger(0), SEXP ncterms=ScalarInteger(0) , SEXP dup=ScalarLogical(1)) { if( TYPEOF(v) == REALSXP ) return divergence_update_W(NUMERIC_POINTER(v), w, h , *INTEGER(nbterms), *INTEGER(ncterms) , *LOGICAL(dup)); else return divergence_update_W(INTEGER_POINTER(v), w, h , *INTEGER(nbterms), *INTEGER(ncterms) , *LOGICAL(dup)); } #define NMF_DIVERGENCE_DONE #else // END OF NMF_DIVERGENCE_H #ifndef NMF_DIVERGENCE_DONE // START DEFINITION OF FUNCTIONS /** * Divergence based multiplicative update for the mixture coefficients matrix H * from Brunet et al. algorithm. * * @param pV target matrix * @param w basis vector matrix * @param h mixture coefficient matrix to be updated * @param nbterms number of fixed basis terms * @param ncterms number of fixed coefficient terms * @param dup boolean (flag) that specifies if the update must be perform directly on w or * on a duplicated version of w * * @return the updated mixture coefficient matrix. * */ template static SEXP divergence_update_H ( T_Rnumeric* pV, SEXP w, SEXP h, int nbterms=0, int ncterms=0, int dup=1) { SEXP res; int nprotect = 0; // retrieve dimensions from W and H int n = INTEGER(GET_DIM(w))[0]; int r = INTEGER(GET_DIM(w))[1]; int p = INTEGER(GET_DIM(h))[1]; // get number of non-fixed terms int vr = r - ncterms; // duplicate H (keeping attributes) or modify in place PROTECT(res = (dup != 0 ? duplicate(h) : h) ); nprotect++; // define internal pointers double* pW = NUMERIC_POINTER(w); double* pH = NUMERIC_POINTER(h); double* p_res = NUMERIC_POINTER(res); // allocate internal memory double* sumW = (double*) R_alloc(r, sizeof(double)); // will store column sums of W double* pWH = (double*) R_alloc(n, sizeof(double)); // will store the currently used column of WH // Compute update of H column by column for(int jH=0; jH < p; ++jH){ for (int iH=0; iH < vr; ++iH){ // compute value for H_ij (non-fixed terms only) // initialise values double tmp_res = 0.0; double &w_sum = sumW[iH]; if( jH == 0 ) w_sum = 0.0; // compute cross-product w_.i by (v/wh)_.j for( int u=0; u compute once and store the result for using for the next rows double wh_term = pWH[u]; if( iH == 0 ){ wh_term = 0.0; for (int k=0; k static SEXP divergence_update_W ( T_Rnumeric* pV, SEXP w, SEXP h, int nbterms=0, int ncterms=0, int dup=1) { SEXP res; int nprotect = 0; // retrieve dimensions int n = INTEGER(GET_DIM(w))[0]; int r = INTEGER(GET_DIM(w))[1]; int p = INTEGER(GET_DIM(h))[1]; // duplicate W (keeping attributes) PROTECT(res = (dup != 0 ? duplicate(w) : w) ); nprotect++; // define internal pointers double* pW = NUMERIC_POINTER(w); double* pH = NUMERIC_POINTER(h); double* p_res = NUMERIC_POINTER(res); // allocate internal memory double* sumH = (double*) R_alloc(r, sizeof(double)); // will store the row sums of H double* pWH = (double*) R_alloc(p, sizeof(double)); // will store currently used row of WH // Compute update of W row by row for(int iW=0; iW < n; iW++){ for (int jW=0; jW < r; jW++){ // compute value for W_ij // initialise values double tmp_res = 0.0; double &h_sum = sumH[jW]; if( iW == 0 ) h_sum = 0.0; // compute cross-product (v/wh)_i. by h_j. for( int u=0; u compute once and store the result for using for the next columns if( jW == 0 ){ double wh_term = 0.0; for (int k=0; k #include #include extern "C" { // NMF from Lee and Seung (based on Euclidean norm) SEXP euclidean_update_H ( SEXP v, SEXP w, SEXP h, SEXP eps, SEXP nbterms, SEXP ncterms, SEXP dup); SEXP euclidean_update_W ( SEXP v, SEXP w, SEXP h, SEXP eps, SEXP weight, SEXP nbterms, SEXP ncterms, SEXP dup); // NMF with offset SEXP offset_euclidean_update_H ( SEXP v, SEXP w, SEXP h, SEXP offset, SEXP eps, SEXP dup); SEXP offset_euclidean_update_W ( SEXP v, SEXP w, SEXP h, SEXP offset, SEXP eps, SEXP dup); } ////////////////////////////////// // STANDARD NMF: LEE ////////////////////////////////// // include version for both double/integer storage.mode (defined as templates) #include "euclidean.cpp" // define the exported versions (for SEXP) SEXP euclidean_update_H ( SEXP v, SEXP w, SEXP h, SEXP eps , SEXP nbterms=ScalarInteger(0), SEXP ncterms=ScalarInteger(0) , SEXP dup=ScalarLogical(1)){ if( TYPEOF(v) == REALSXP ){ return euclidean_update_H(NUMERIC_POINTER(v), w, h, eps , *INTEGER(nbterms), *INTEGER(ncterms) , *LOGICAL(dup)); }else{ return euclidean_update_H(INTEGER_POINTER(v), w, h, eps , *INTEGER(nbterms), *INTEGER(ncterms) , *LOGICAL(dup)); } } ////////////////////////////////// // NMF WITH WEIGHT ////////////////////////////////// #define NMF_WITH_WEIGHT #include "euclidean.cpp" #undef NMF_WITH_WEIGHT SEXP euclidean_update_W ( SEXP v, SEXP w, SEXP h, SEXP eps , SEXP weight = R_NilValue , SEXP nbterms=ScalarInteger(0), SEXP ncterms=ScalarInteger(0) , SEXP dup=ScalarLogical(1)){ int nb = *INTEGER(nbterms), nc = *INTEGER(ncterms); bool copy = *LOGICAL(dup); if( TYPEOF(v) == REALSXP ){ if( isNull(weight) ){ return euclidean_update_W(NUMERIC_POINTER(v), w, h, eps, nb, nc, copy); }else{ return weuclidean_update_W(NUMERIC_POINTER(v), w, h, eps, weight, nb, nc, copy); } }else{ if( isNull(weight) ){ return euclidean_update_W(INTEGER_POINTER(v), w, h, eps, nb, nc, copy); }else{ return weuclidean_update_W(INTEGER_POINTER(v), w, h, eps, weight, nb, nc, copy); } } } ////////////////////////////////// // NMF WITH OFFSET ////////////////////////////////// #define NMF_WITH_OFFSET // include version for both double/integer storage.mode (defined as templates) #include "euclidean.cpp" #undef NMF_WITH_OFFSET // define the exported versions (for SEXP) SEXP offset_euclidean_update_H ( SEXP v, SEXP w, SEXP h, SEXP offset, SEXP eps, SEXP dup=ScalarLogical(1)){ if( TYPEOF(v) == REALSXP ) return offset_euclidean_update_H(NUMERIC_POINTER(v), w, h, offset, eps, *LOGICAL(dup)); else return offset_euclidean_update_H(INTEGER_POINTER(v), w, h, offset, eps, *LOGICAL(dup)); } SEXP offset_euclidean_update_W ( SEXP v, SEXP w, SEXP h, SEXP offset, SEXP eps, SEXP dup=ScalarLogical(1)){ if( TYPEOF(v) == REALSXP ) return offset_euclidean_update_W(NUMERIC_POINTER(v), w, h, offset, eps, *LOGICAL(dup)); else return offset_euclidean_update_W(INTEGER_POINTER(v), w, h, offset, eps, *LOGICAL(dup)); } #define NMF_EUCLIDEAN_DONE #else // END OF NMF_EUCLIDEAN_H #ifndef NMF_EUCLIDEAN_DONE // START DEFINITION OF FUNCTIONS /** * Euclidean norm based multiplicative update for the mixture coefficients matrix H * from Lee and Seung. * Also used in the NMF with Offset algorithm * * Note: for performance reason the dimension names are NOT conserved. */ #ifndef NMF_WITH_WEIGHT template static #ifdef NMF_WITH_OFFSET SEXP offset_euclidean_update_H ( #else SEXP euclidean_update_H ( #endif T_Rnumeric* pV, SEXP w, SEXP h #ifdef NMF_WITH_OFFSET , SEXP offset #endif , SEXP eps #ifndef NMF_WITH_OFFSET , int nbterms=0, int ncterms=0 #endif , int dup=1) { SEXP res; int nprotect = 0; double eps_val = *NUMERIC_POINTER(eps); // retrieve dimensions int n = INTEGER(GET_DIM(w))[0]; int r = INTEGER(GET_DIM(w))[1]; int p = INTEGER(GET_DIM(h))[1]; // get number of non-fixed terms int vr = #ifdef NMF_WITH_OFFSET r; #else r - ncterms; #endif // duplicate H (keeping attributes) PROTECT( res = (dup != 0 ? duplicate(h) : h) ); nprotect++; // define internal pointers double* pW = NUMERIC_POINTER(w); double* pH = NUMERIC_POINTER(h); double* p_res = NUMERIC_POINTER(res); double* pH_buffer = (double*) R_alloc(r, sizeof(double)); // extra variables in the case of an optional offset #ifdef NMF_WITH_OFFSET double *pOffset = NULL, *den_addon = NULL; if( offset != R_NilValue ){ pOffset = NUMERIC_POINTER(offset); den_addon = (double*) R_alloc(r, sizeof(double)); //memset(den_addon, 0, r); } #endif // auxiliary temporary variable double temp = 0.0; // Pre-compute symmetric matrix t(W)W // -> allocate internal memory as a upper triangular in column major double* p_tWW = (double*) R_alloc((int) (r*(r+1))/2, sizeof(double)); double* p_row = NULL; for( int i=r-1; i>=0; --i){ p_row = pW + i*n; #ifdef NMF_WITH_OFFSET den_addon[i] = 0.0; #endif for( int j=r-1; j>=0; --j){ temp = 0.0; for( int u=n-1; u>=0; --u){ temp += p_row[u] * pW[u + j*n]; #ifdef NMF_WITH_OFFSET if( pOffset != NULL && j==0 ) den_addon[i] += p_row[u] * pOffset[u]; #endif } p_tWW[((j+1)*j)/2 + i] = temp; } } // H_au = H_au (W^T V)_au / (W^T W H)_au // Compute update of H column by column for (int j=p-1; j>=0; --j){ for(int i=vr-1; i>=0; --i){ // compute value for H_ij (only non-fixed entries) // numerator double numerator = 0.0; for( int u=n-1; u>=0; --u) numerator += pW[u + i*n] * pV[u + j*n]; double den = 0.0; for( int l=r-1; l>=0; --l){ // use all entries (fixed and non-fixed) // bufferize jth-column of H, as it can be changed at the end of the current i-loop if( i==vr-1 ) pH_buffer[l] = pH[l + j*r]; den += p_tWW[i > l ? ((i+1)*i)/2 + l : ((l+1)*l)/2 + i] * pH_buffer[l]; } // add offset addon if necessary #ifdef NMF_WITH_OFFSET if( pOffset != NULL ) den += den_addon[i]; #endif // multiplicative update p_res[i + j*r] = ((temp = pH_buffer[i] * numerator) > eps_val ? temp : eps_val) / (den + eps_val); } } // return result UNPROTECT(nprotect); return res; } #endif /** * Euclidean norm based multiplicative update for the basis matrix W * from Lee and Seung. * Also used in the NMF with Offset algorithm * * Note: for performance reason the dimension names are NOT conserved. */ template static SEXP #ifdef NMF_WITH_OFFSET offset_euclidean_update_W #else #ifdef NMF_WITH_WEIGHT weuclidean_update_W #else euclidean_update_W #endif #endif (T_Rnumeric* pV, SEXP w, SEXP h #ifdef NMF_WITH_OFFSET , SEXP offset #endif , SEXP eps #ifdef NMF_WITH_WEIGHT , SEXP weight #endif #ifndef NMF_WITH_OFFSET , int nbterms=0, int ncterms=0 #endif , int dup=1) { SEXP res; int nprotect = 0; // setup variables for enforcing a limit Inf on the entries double limInf = *NUMERIC_POINTER(eps); // retrieve dimensions int n = INTEGER(GET_DIM(w))[0]; int r = INTEGER(GET_DIM(w))[1]; int p = INTEGER(GET_DIM(h))[1]; // duplicate H (keeping attributes) //PROTECT(res = duplicate(w)); nprotect++; PROTECT(res = (dup != 0 ? duplicate(w) : w) ); nprotect++; // define internal pointers to data double* pW = NUMERIC_POINTER(w); double* pH = NUMERIC_POINTER(h); double* p_res = NUMERIC_POINTER(res); double* pW_buffer = (double*) R_alloc(r, sizeof(double)); // extra variables in the case of an optional offset #ifdef NMF_WITH_OFFSET double *pOffset = NULL, *rowSumsH = NULL; if( offset != R_NilValue ){ pOffset = NUMERIC_POINTER(offset); // pre-compute the row sums of H rowSumsH = (double*) R_alloc(r, sizeof(double)); for( int i=r-1; i>=0; --i){ rowSumsH[i] = 0.0; for( int j=p-1; j>=0; --j){ rowSumsH[i] += pH[i + j*r]; } } } #endif #ifdef NMF_WITH_WEIGHT // take sample weights into account double* p_weight = !isNull(weight) ? NUMERIC_POINTER(weight) : NULL; double beta = -1.0; if( p_weight == NULL ){// <=> no weights beta = 1.0; } else if( length(weight) == 1 ){// all weighted are the same // NB: theoretically this is equivalent to weight=1, but may be used // to test it in practice (with the numerical adjustments via eps) beta = *p_weight; } // fill weight vector with single value if( beta > 0 ){ double* pw = p_weight = (double*) R_alloc(p, sizeof(double)); for(int i=0; i allocate internal memory as a lower triangular in column major double* p_HtH = (double*) R_alloc((int) (r*(r+1))/2, sizeof(double)); for( int j=r-1; j>=0; --j){ for( int i=j; i=0; --u){ temp += pH[j + u*r] * pH[i + u*r] #ifdef NMF_WITH_WEIGHT * p_weight[u] #endif ; } p_HtH[((i+1)*i)/2 + j] = temp; } } // W_ia = W_ia (V H^T)_ia / (W H H^T)_ia and columns are rescaled after each iteration // Compute update of W row by row double numerator = 0.0; double den = 0.0; for(int i=n-1; i>=0; --i){ for (int j=r-1; j>=0; --j){// compute value for W_ij // numerator numerator = 0.0; for( int u=p-1; u>=0; --u){ numerator += pV[i + u*n] * pH[j + u*r] #ifdef NMF_WITH_WEIGHT * p_weight[u] #endif ; } den = 0.0; for( int l=r-1; l>=0; --l){ // bufferize ith-row of W, as it can be changed at the end of the current j-loop if( j==r-1 ) pW_buffer[l] = pW[i + l*n]; // compute index of the stored value of t(w)w_[iH,l] in column major den += pW_buffer[l] * p_HtH[l < j ? ((j+1)*j)/2 + l : ((l+1)*l)/2 + j]; } // add offset addon if necessary #ifdef NMF_WITH_OFFSET if( pOffset != NULL ) den += pOffset[i] * rowSumsH[j]; #endif // multiplicative update temp = pW_buffer[j] * numerator; p_res[i + j*n] = ( temp < limInf ? limInf : temp ) / (den + limInf); } } // return result UNPROTECT(nprotect); return res; } #endif //END ifndef NMF_EUCLIDEAN_DONE #endif //END ifdef NMF_EUCLIDEAN_H NMF/src/utils.cpp0000644000176000001440000001515212530712567013371 0ustar ripleyusers#ifndef NMF_UTILS_H // include header only once #define NMF_UTILS_H #include #include #include extern "C" { /** Returns the pointer address of 'x' as a character string*/ SEXP ptr_address (SEXP x); /** Clone an object 'x'*/ SEXP clone_object (SEXP x); /** pmin in place with 'y' being a single numeric value*/ SEXP ptr_pmax (SEXP x, SEXP y, SEXP skip); /** Apply inequality constraints in place. */ SEXP ptr_neq_constraints(SEXP x, SEXP constraints, SEXP ratio=R_NilValue, SEXP value=R_NilValue); /** Minimum per column*/ SEXP colMin(SEXP x); /** Maximum per row*/ SEXP colMax(SEXP x); /** Test if an external pointer is null. * * Function taken from the package bigmemory (v4.2.11). */ SEXP ptr_isnil(SEXP address) { void *ptr = R_ExternalPtrAddr(address); SEXP ret = PROTECT(NEW_LOGICAL(1)); LOGICAL_DATA(ret)[0] = (ptr==NULL) ? (Rboolean)TRUE : Rboolean(FALSE); UNPROTECT(1); return(ret); } } // define the exported versions (for SEXP) SEXP ptr_address (SEXP x){ SEXP ans = R_NilValue; char tmp[15]; PROTECT(ans = allocVector(STRSXP, 1)); sprintf(tmp, "%p", (void *) x); SET_STRING_ELT(ans, 0, mkChar(tmp)); UNPROTECT(1); return ans; } SEXP clone_object (SEXP x){ return Rf_duplicate(x); } SEXP ptr_pmax(SEXP x, SEXP y, SEXP skip=R_NilValue){ int n = length(x); double* p_x = ( isNull(x) ? NULL : NUMERIC_POINTER(x) ); double lim = isNull(y) ? -1.0 : *NUMERIC_POINTER(y); // backup skipped values int n_skip = length(skip); int ncol = isNull(GET_DIM(x)) ? 1 : INTEGER(GET_DIM(x))[1]; int nrow = n / ncol; double* old_value = NULL; int* p_skip = NULL; if( !isNull(skip) && n_skip > 0 ){ old_value = (double*) R_alloc(n_skip*ncol, sizeof(double)); p_skip = INTEGER_POINTER(skip); for(int k=ncol-1; k>=0; --k){ for(int i=n_skip-1; i>=0; --i){ //Rprintf("skip %i x %i\n", i, k); int is = p_skip[i]-1; double val = p_x[k*nrow + is]; old_value[k*n_skip + i] = val; } } } // apply limit inf to all values double* p_x2 = p_x + n-1; for(int i=n-1; i>=0; --i){ if( *p_x2 < lim ) *p_x2 = lim; --p_x2; } p_x2 = NULL; // restore skipped values if( !isNull(skip) && n_skip > 0 ){ for(int k=ncol-1; k>=0; --k){ for(int i=n_skip-1; i>=0; --i){ //Rprintf("restore %i x %i\n", i, k); int is = p_skip[i]-1; p_x[k*nrow + is] = old_value[k*n_skip + i]; } } } // return modified x return x; } /** Apply inequality constraints in place. */ SEXP ptr_neq_constraints(SEXP x, SEXP constraints, SEXP ratio, SEXP value){ double* p_x = ( isNull(x) ? NULL : NUMERIC_POINTER(x) ); double d_ratio = isNull(ratio) ? 0 : *NUMERIC_POINTER(ratio); double* p_value = ( isNull(value) ? NULL : NUMERIC_POINTER(value) ); double eps = sqrt(DOUBLE_EPS); // get dimensions int ncol = isNull(GET_DIM(x)) ? 1 : INTEGER(GET_DIM(x))[1]; int nrow = isNull(GET_DIM(x)) ? length(x) : INTEGER(GET_DIM(x))[0]; int nc = length(constraints); if( nc != ncol ) error("There must be as many elements in list `constraints` as columns in `x`."); // apply each set of constraints (from first to last) double* _xj = p_x; // pointer to marked column double* _x_last = p_x + (ncol - 1) * nrow; // pointer to last column for(int j=0; j=0; --k){ double lim = d_ratio != 0.0 ? _xj[p_i[k]-1] / d_ratio - eps : 0.0; if( lim < 0 ) lim = 0; // apply constraints on each column // pointer to current row in last column double* _xi = _x_last + p_i[k]-1; for(int l=ncol-1; l>=0; --l){ //Rprintf("Before: xi=%f > lim=%f ? => ", lim, *_xi); if( l != j && *_xi > lim ){ // constrain column to 'lim' *_xi = lim; }else if( l == j && p_value != NULL ){ // constrain column to 'value' *_xi = *p_value; } //Rprintf("xi=%f\n", *_xi); // move to previous column _xi -= nrow; } _xi = NULL; } // move to next marked column _xj += nrow; } // return modified x return x; } template inline void colMin(T* x, int n, int p, T* res, const T& NA_value){ // do nothing if there is no data or fill with NAs if( n <= 0 ){ if( p <= 0 ) return; for(int j=p-1; j>=0; --j, ++res) *res = NA_value; } for(int j=p-1; j>=0; --j, ++res){ *res = *(x++); for(int i=n-2; i>=0; --i, ++x){ if( *res > *x ) *res = *x; } } } template inline void colMax(T* x, int n, int p, T* res, const T& NA_value){ // do nothing if there is no data or fill with NAs if( n <= 0 ){ if( p <= 0 ) return; for(int j=p-1; j>=0; --j, ++res) *res = NA_value; } for(int j=p-1; j>=0; --j, ++res){ *res = *(x++); for(int i=n-2; i>=0; --i, ++x){ if( *res < *x ) *res = *x; } } } /** * Minimum per column */ SEXP colMin(SEXP x){ SEXP ans, dims; // check that the argument is a matrix dims = GET_DIM(x); if (dims == R_NilValue) error("a matrix-like object is required as argument to 'colMin'"); // check that it is a numeric data if (!isNumeric(x)) error("a numeric object is required as argument to 'colMin'"); // get the dimension of the input matrix int n = INTEGER(dims)[0]; int p = INTEGER(dims)[1]; if( TYPEOF(x) == REALSXP ){ // allocate memory for the result (a vector of length the number of columns of x) PROTECT(ans = allocVector(REALSXP, p)); colMin(NUMERIC_POINTER(x), n, p, NUMERIC_POINTER(ans), NA_REAL); UNPROTECT(1); } else{ // allocate memory for the result (a vector of length the number of columns of x) PROTECT(ans = allocVector(INTSXP, p)); colMin(INTEGER_POINTER(x), n, p, INTEGER_POINTER(ans), NA_INTEGER); UNPROTECT(1); } return ans; } /** * Maximum per column */ SEXP colMax(SEXP x){ SEXP ans, dims; // check that the argument is a matrix dims = GET_DIM(x); if (dims == R_NilValue) error("a matrix-like object is required as argument to 'colMax'"); // check that it is a numeric data if (!isNumeric(x)) error("a numeric object is required as argument to 'colMax'"); // get the dimension of the input matrix int n = INTEGER(dims)[0]; int p = INTEGER(dims)[1]; if( TYPEOF(x) == REALSXP ){ // allocate memory for the result (a vector of length the number of columns of x) PROTECT(ans = allocVector(REALSXP, p)); colMax(NUMERIC_POINTER(x), n, p, NUMERIC_POINTER(ans), NA_REAL); UNPROTECT(1); } else{ // allocate memory for the result (a vector of length the number of columns of x) PROTECT(ans = allocVector(INTSXP, p)); colMax(INTEGER_POINTER(x), n, p, INTEGER_POINTER(ans), NA_INTEGER); UNPROTECT(1); } return ans; } #endif //END ifdef NMF_UTILS_H NMF/src/distance.cpp0000644000176000001440000000757112530712567014031 0ustar ripleyusers#ifndef NMF_DISTANCE_H // include header only once #define NMF_DISTANCE_H #include #include #include extern "C" { SEXP Euclidean_rss( SEXP x, SEXP y); SEXP KL_divergence( SEXP x, SEXP y); } //define helper macro #define both_non_NA(a,b) (!ISNAN(a) && !ISNAN(b)) // include versions for double-double storage.mode #include "distance.cpp" // include versions for double-integer storage.mode #define NMF_ARG2_INT #include "distance.cpp" #undef NMF_ARG2_INT // include versions for integer-* storage.mode #define NMF_ARG1_INT #include "distance.cpp" // include versions for integer-integer storage.mode #define NMF_ARG2_INT #include "distance.cpp" #undef NMF_ARG2_INT #undef NMF_ARG1_INT // define the exported version of RSS (for SEXP) SEXP Euclidean_rss ( SEXP x, SEXP y){ // retrieve dimensions int n = INTEGER(GET_DIM(x))[0]; int p = INTEGER(GET_DIM(x))[1]; if( INTEGER(GET_DIM(y))[0] != n ) error("non-conformable arrays (rows)"); if( INTEGER(GET_DIM(y))[1] != p ) error("non-conformable arrays (columns)"); if( TYPEOF(x) == REALSXP ){// x is double if( TYPEOF(y) == REALSXP )// x and y are double return rss( NUMERIC_POINTER(x), NUMERIC_POINTER(y), n, p); else// x is double, y is integer return rss( NUMERIC_POINTER(x), INTEGER_POINTER(y), n, p); }else{ if( TYPEOF(y) == REALSXP ) // x is integer, y is double return rss( INTEGER_POINTER(x), NUMERIC_POINTER(y), n, p); else // x is integer, y is integer return rss( INTEGER_POINTER(x), INTEGER_POINTER(y), n, p); } } // define the exported version of KL (for SEXP) SEXP KL_divergence ( SEXP x, SEXP y){ // retrieve dimensions int n = INTEGER(GET_DIM(x))[0]; int p = INTEGER(GET_DIM(x))[1]; if( INTEGER(GET_DIM(y))[0] != n ) error("non-conformable arrays (rows)"); if( INTEGER(GET_DIM(y))[1] != p ) error("non-conformable arrays (columns)"); if( TYPEOF(x) == REALSXP ){// x is double if( TYPEOF(y) == REALSXP )// x and y are double return KL( NUMERIC_POINTER(x), NUMERIC_POINTER(y), n, p); else// x is double, y is integer return KL( NUMERIC_POINTER(x), INTEGER_POINTER(y), n, p); }else{ if( TYPEOF(y) == REALSXP ) // x is integer, y is double return KL( INTEGER_POINTER(x), NUMERIC_POINTER(y), n, p); else // x is integer, y is integer return KL( INTEGER_POINTER(x), INTEGER_POINTER(y), n, p); } } #define NMF_DISTANCE_DONE #else // END OF NMF_DISTANCE_H #ifndef NMF_DISTANCE_DONE // START DEFINITION OF FUNCTIONS // Internal function that computes the RSS SEXP rss( #ifdef NMF_ARG1_INT int* #else double* #endif px, #ifdef NMF_ARG2_INT int* #else double* #endif py , int n, int p){ double dev=0, dist=0; double xval, yval; //int count = 0; for(int i=n-1; i>=0; --i) { for(int j=p-1; j>=0; --j) { xval = px[i + j*n]; yval = py[i + j*n]; if (both_non_NA(xval, yval)) { dev = xval - yval; if (!ISNAN(dev)) { dist += dev * dev; //count++; } else return ScalarReal(NA_REAL); } else return ScalarReal(NA_REAL); } } //if (count == 0) return ScalarReal(NA_REAL); return ScalarReal(dist); } // Internal function that computes the KL divergence SEXP KL( #ifdef NMF_ARG1_INT int* #else double* #endif px, #ifdef NMF_ARG2_INT int* #else double* #endif py , int n, int p){ double dev=0, dist=0; double xval, yval; for(int i=n-1; i>=0; --i) { for(int j=p-1; j>=0; --j) { xval = px[i + j*n]; yval = py[i + j*n]; if( xval == 0 ) dev = yval; else if (both_non_NA(xval, yval)) dev = xval * log((double) xval / yval) - xval + yval; else return ScalarReal(NA_REAL); // only add and continue if the term is not NA if ( R_FINITE(dev) ) dist += dev; else return ScalarReal(dev); } } return ScalarReal(dist); } #endif //END ifndef NMF_DISTANCE_DONE #endif //END ifdef NMF_DISTANCE_H NMF/NAMESPACE0000644000176000001440000001121212305630424012135 0ustar ripleyusersexport(rmatrix) export(str_args) export(randomize) export(pmax.inplace) export(neq.constraints.inplace) export(nmfObject) export(algorithm) export("algorithm<-") export(seeding) export("seeding<-") export(niter) export("niter<-") export(nrun) export(objective) export("objective<-") export(runtime) export(runtime.all) export(seqtime) export(modelname) export(run) export(logs) export(compare) export(nmf.options) export(nmf.getOption) export(nmf.resetOptions) export(nmf.printOptions) export(.atrack) export(match_atrack) export(atrack) export(aheatmap) export(fitted) export(basis) export(.basis) export("basis<-") export(".basis<-") export(loadings) export(coef) export(.coef) export("coef<-") export(".coef<-") export(coefficients) export(scoef) export(rnmf) export(is.nmf) export(nbasis) export(basisnames) export("basisnames<-") export(misc) export(is.empty.nmf) export(hasBasis) export(hasCoef) export(is.partial.nmf) export(summary) export(sparseness) export(purity) export(entropy) export(nmfApply) export(predict) export(basiscor) export(profcor) export(connectivity) export(rss) export(evar) export(deviance) export(nmfDistance) export(nmf.equal) export(nneg) export(posneg) export(offset) export(metaHeatmap) export(basismap) export(coefmap) export(smoothing) export(nmfModel) export(nmfModels) export(ibterms) export(icterms) export(iterms) export(nterms) export(nbterms) export(ncterms) export(bterms) export(cterms) export(ibasis) export(icoef) export(fit) export("fit<-") export(minfit) export(residuals) export("residuals<-") export(hasTrack) export(trackError) export(isNMFfit) export(consensus) export(consensushc) export(getRNG1) export(which.best) export(.getRNG) export(dispersion) export(consensusmap) export(cophcor) export(name) export("name<-") export(NMFStrategy) export(is.mixed) export(nmfFormals) export(nmfArgs) export(NMFSeed) export(staticVar) export(nmf_update.KL.h) export(nmf_update.KL.h_R) export(nmf_update.KL.w) export(nmf_update.KL.w_R) export(nmf_update.euclidean.h) export(nmf_update.euclidean.h_R) export(nmf_update.euclidean.w) export(nmf_update.euclidean.w_R) export(NMFStop) export(nmf.stop.iteration) export(nmf.stop.threshold) export(nmf.stop.stationary) export(nmf.stop.connectivity) export(profplot) export(profplot.default) export(setNMFMethod) export(nmfRegisterAlgorithm) export(canFit) export(getNMFMethod) export(nmfAlgorithm) export(existsNMFMethod) export(removeNMFMethod) export(nmfWrapper) export(nmf_update.brunet_R) export(nmf_update.brunet) export(nmf_update.lee_R) export(nmf_update.lee) export(nmf_update.euclidean_offset.h) export(nmf_update.euclidean_offset.w) export(nmf_update.offset_R) export(nmf_update.offset) export(nmf_update.ns) export(nmf_update.ns_R) export(fcnnls) export(.fcnnls) export(featureScore) export(extractFeatures) export(nmfSeed) export(getNMFSeed) export(existsNMFSeed) export(setNMFSeed) export(removeNMFSeed) export(getDoBackend) export(setDoBackend) export(register) export(ForeachBackend) export(getDoParHosts) export(getDoParNHosts) export(ts_eval) export(ts_tempfile) export(hostfile) export(gVariable) export(nmf) export(seed) export(nmfEstimateRank) export(nmfReport) export(syntheticNMF) export(nmfCheck) exportClasses(NMF) exportClasses(NMFstd) exportClasses(NMFOffset) exportClasses(NMFns) exportClasses(NMFfit) exportClasses(NMFList) exportClasses(NMFfitX) exportClasses(NMFfitX1) exportClasses(NMFfitXn) exportMethods(show) exportMethods(dim) exportMethods(dimnames) exportMethods("dimnames<-") exportMethods("[") exportMethods("$") exportMethods("$<-") exportMethods(.DollarNames) exportMethods(rposneg) exportMethods(fitted) exportMethods(plot) exportMethods(objective) exportMethods("objective<-") exportPattern("^featureNames") exportPattern("^sampleNames") exportPattern("^metagenes") exportPattern("^metaprofiles") exportPattern("^nmeta") import(graphics) import(rngtools) import(digest) import(stringr) import(stats) import(methods) import(grid) import(RColorBrewer) import(colorspace) import(grDevices) import(gridBase) import(pkgmaker) import(registry) import(cluster) import(foreach) import(doParallel) import(ggplot2) import(reshape2) importFrom(utils,.DollarNames) S3method(scale,NMF) S3method(.DollarNames,NMF) S3method(t,NMF) S3method(t,NMFstd) S3method(plot,NMF.consensus) S3method(nmfFormals,character) S3method(nmfFormals,NMFStrategy) S3method(nmfFormals,NMFStrategyFunction) S3method(nmfFormals,NMFStrategyIterative) S3method(profplot,default) S3method(silhouette,NMF) S3method(silhouette,NMFfitX) S3method(print,fcnnls) S3method(register,foreach_backend) S3method(register,doParallel_backend) S3method(register,doMPI_backend) S3method(print,foreach_backend) S3method(summary,NMF.rank) S3method(plot,NMF.rank) useDynLib(NMF) NMF/demo/0000755000176000001440000000000012305630424011645 5ustar ripleyusersNMF/demo/aheatmap.R0000644000176000001440000000365712307551542013570 0ustar ripleyusers# Generate random data n <- 50; p <- 20 x <- abs(rmatrix(n, p, rnorm, mean=4, sd=1)) x[1:10, seq(1, 10, 2)] <- x[1:10, seq(1, 10, 2)] + 3 x[11:20, seq(2, 10, 2)] <- x[11:20, seq(2, 10, 2)] + 2 rownames(x) <- paste("ROW", 1:n) colnames(x) <- paste("COL", 1:p) ## Scaling aheatmap(x, scale = "row") aheatmap(x, scale = "col") # partially matched to 'column' aheatmap(x, scale = "r1") # each row sum up to 1 aheatmap(x, scale = "c1") # each colum sum up to 1 ## Heatmap colors aheatmap(x, color = colorRampPalette(c("navy", "white", "firebrick3"))(50)) # color specification as an integer: use R basic colors aheatmap(x, color = 1L) # color specification as a negative integer: use reverse basic palette aheatmap(x, color = -1L) # color specification as a numeric: use HCL color aheatmap(x, color = 1) # do not cluster the rows aheatmap(x, Rowv = NA) # no heatmap legend aheatmap(x, legend = FALSE) # cell and font size aheatmap(x, cellwidth = 10, cellheight = 5) # directly write into a file aheatmap(x, cellwidth = 15, cellheight = 12, fontsize = 8, filename = "aheatmap.pdf") unlink('aheatmap.pdf') # Generate column annotations annotation = data.frame(Var1 = factor(1:p %% 2 == 0, labels = c("Class1", "Class2")), Var2 = 1:10) aheatmap(x, annCol = annotation) aheatmap(x, annCol = annotation, annLegend = FALSE) # Specify colors Var1 = c("navy", "darkgreen") names(Var1) = c("Class1", "Class2") Var2 = c("lightgreen", "navy") ann_colors = list(Var1 = Var1, Var2 = Var2) aheatmap(x, annCol = annotation, annColors = ann_colors) # Specifying clustering from distance matrix drows = dist(x, method = "minkowski") dcols = dist(t(x), method = "minkowski") aheatmap(x, Rowv = drows, Colv = dcols) # Display text in each cells t <- outer(as.character(outer(letters, letters, paste0)), letters, paste0)[1:n, 1:p] aheatmap(x, txt = t) # NA values are shown as empty cells t.na <- t t.na[sample(length(t.na), 500)] <- NA # half of the cells aheatmap(x, txt = t.na) NMF/demo/00Index0000644000176000001440000000013712307551603013003 0ustar ripleyusersnmf Using the main function nmf() heatmaps Heatmaps of NMF objects aheatmap Annotated heatmaps NMF/demo/nmf.R0000644000176000001440000001201612307551603012553 0ustar ripleyusers# generate a synthetic dataset with known classes: 50 features, 23 samples (10+5+8) n <- 20; counts <- c(5, 3, 2); p <- sum(counts) x <- syntheticNMF(n, counts) dim(x) # build the true cluster membership groups <- unlist(mapply(rep, seq(counts), counts)) # run on a data.frame res <- nmf(data.frame(x), 3) # missing method: use algorithm suitable for seed res <- nmf(x, 2, seed=rnmf(2, x)) algorithm(res) res <- nmf(x, 2, seed=rnmf(2, x, model='NMFns')) algorithm(res) # compare some NMF algorithms (tracking the approximation error) res <- nmf(x, 2, list('brunet', 'lee', 'nsNMF'), .options='t') res summary(res, class=groups) # plot the track of the residual errors plot(res) # specify algorithm by its name res <- nmf(x, 3, 'nsNMF', seed=123) # nonsmooth NMF # names are partially matched so this also works identical(res, nmf(x, 3, 'ns', seed=123)) res <- nmf(x, 3, 'offset') # NMF with offset # run a custom algorithm defined as a standard function myfun <- function(x, start, alpha){ # update starting point # ... basis(start) <- 3 * basis(start) # return updated point start } res <- nmf(x, 2, myfun, alpha=3) algorithm(res) # error: alpha missing try( nmf(x, 2, myfun) ) # possibly the algorithm fits a non-standard NMF model, e.g. NMFns model res <- nmf(x, 2, myfun, alpha=3, model='NMFns') modelname(res) # assume a known NMF model compatible with the matrix `x` y <- rnmf(3, x) # fits an NMF model (with default method) on some data using y as a starting point res <- nmf(x, y) # the fit can be reproduced using the same starting point nmf.equal(nmf(x, y), res) # missing method: use default algorithm res <- nmf(x, 3) # Fit a 3-rank model providing an initial value for the basis matrix nmf(x, rmatrix(nrow(x), 3), 'snmf/r') # Fit a 3-rank model providing an initial value for the mixture coefficient matrix nmf(x, rmatrix(3, ncol(x)), 'snmf/l') # default fit res <- nmf(x, 2) summary(res, class=groups) # run default algorithm multiple times (only keep the best fit) res <- nmf(x, 3, nrun=10) res summary(res, class=groups) # run default algorithm multiple times keeping all the fits res <- nmf(x, 3, nrun=10, .options='k') res summary(res, class=groups) ## Note: one could have equivalently done # res <- nmf(V, 3, nrun=10, .options=list(keep.all=TRUE)) # use a method that fit different model res <- nmf(x, 2, 'nsNMF') fit(res) # pass parameter theta to the model via `...` res <- nmf(x, 2, 'nsNMF', theta=0.2) fit(res) ## handling arguments in `...` and model parameters myfun <- function(x, start, theta=100){ cat("theta in myfun=", theta, "\n\n"); start } # no conflict: default theta fit( nmf(x, 2, myfun) ) # no conlfict: theta is passed to the algorithm fit( nmf(x, 2, myfun, theta=1) ) # conflict: theta is used as model parameter fit( nmf(x, 2, myfun, model='NMFns', theta=0.1) ) # conflict solved: can pass different theta to model and algorithm fit( nmf(x, 2, myfun, model=list('NMFns', theta=0.1), theta=5) ) ## USING SEEDING METHODS # run default algorithm with the Non-negative Double SVD seeding method ('nndsvd') res <- nmf(x, 3, seed='nndsvd') ## Note: partial match also works identical(res, nmf(x, 3, seed='nn')) # run nsNMF algorithm, fixing the seed of the random number generator res <- nmf(x, 3, 'nsNMF', seed=123456) nmf.equal(nmf(x, 3, 'nsNMF', seed=123456), res) # run default algorithm specifying the starting point following the NMF standard model start.std <- nmfModel(W=matrix(0.5, n, 3), H=matrix(0.2, 3, p)) nmf(x, start.std) # to run nsNMF algorithm with an explicit starting point, this one # needs to follow the 'NMFns' model: start.ns <- nmfModel(model='NMFns', W=matrix(0.5, n, 3), H=matrix(0.2, 3, p)) nmf(x, start.ns) # Note: the method name does not need to be specified as it is infered from the # when there is only one algorithm defined for the model. # if the model is not appropriate (as defined by the algorihtm) an error is thrown # [cf. the standard model doesn't include a smoothing parameter used in nsNMF] try( nmf(x, start.std, method='nsNMF') ) ## Callback functions # Pass a callback function to only save summary measure of each run res <- nmf(x, 3, nrun=3, .callback=summary) # the callback results are simplified into a matrix res$.callback res <- nmf(x, 3, nrun=3, .callback=summary, .opt='-S') # the callback results are simplified into a matrix res$.callback # Pass a custom callback function cb <- function(obj, i){ if( i %% 2 ) sparseness(obj) >= 0.5 } res <- nmf(x, 3, nrun=3, .callback=cb) res$.callback # Passs a callback function which throws an error cb <- function(){ i<-0; function(object){ i <<- i+1; if( i == 1 ) stop('SOME BIG ERROR'); summary(object) }} res <- nmf(x, 3, nrun=3, .callback=cb()) ## PARALLEL COMPUTATIONS # try using 3 cores, but use sequential if not possible res <- nmf(x, 3, nrun=3, .options='p3') # force using 3 cores, error if not possible res <- nmf(x, 3, nrun=3, .options='P3') # use externally defined cluster library(parallel) cl <- makeCluster(6) res <- nmf(x, 3, nrun=3, .pbackend=cl) # use externally registered backend registerDoParallel(cl) res <- nmf(x, 3, nrun=3, .pbackend=NULL) NMF/demo/heatmaps.R0000644000176000001440000000170412307551551013601 0ustar ripleyusers#' # random data with underlying NMF model v <- syntheticNMF(20, 3, 10) # estimate a model x <- nmf(v, 3) # highligh row only (using custom colors) basismap(x, tracks=':basis', annColor=list(basis=1:3)) ## character annotation vector: ok if it does not contain 'basis' # annotate first and second row + automatic special track basismap(x, annRow=c('alpha', 'beta')) # no special track here basismap(x, annRow=c('alpha', 'beta', ':basis'), tracks=NA) # with special track `basis` basismap(x, annRow=list(c('alpha', 'beta'), ':basis'), tracks=NA) # highligh columns only (using custom colors) basismap(x, tracks='basis:') # changing the name of the basis annotation track basismap(x, annRow=list(new_name=':basis')) # coefficient matrix coefmap(x, annCol=c('alpha', 'beta')) # annotate first and second sample coefmap(x, annCol=list('basis', Greek=c('alpha', 'beta'))) # annotate first and second sample + basis annotation coefmap(x, annCol=c(new_name='basis')) NMF/NEWS0000644000176000001440000006542512530701601011430 0ustar ripleyusers************************************************************************* Changes in version 0.20.6 ************************************************************************* FIXES o fixed new NOTEs in R CMD check (about requireNamespace) o fixed error in heatmaps due to new version of stringr (>= 1.0.0) ************************************************************************* Changes in version 0.20 ************************************************************************* NEW FEATURES o aheatmap gains an argument txt that enables displaying text in each cell of the heatmap. FIXES o now all examples, vignettes and unit tests comply with CRAN policies on the maximum number of cores to be used when checking packages (2). ************************************************************************* Changes in version 0.18 ************************************************************************* NEW FEATURES o aheatmap gains distfun methods 'spearman', 'kendall', and, for completeness, 'pearson' (for which 'correlation' is now an alias), which specifies the correlation method to use when computing the distance matrix. CHANGES o In order to fully comply with CRAN policies, internals of the aheatmap function slightly changed. In particular, this brings an issue when directly plotting to PDF graphic devices, where a first blank page may appear. See the dedicated section in the man page ?aheatmap for a work around. ************************************************************************* Changes in version 0.17.3 ************************************************************************* NEW FEATURES o add silhouette computation for NMF results, which can be performed on samples, features or consensus matrix. The average silhouette width is also computed by the summary methods. (Thanks to Gordon Robertson for this suggestion) o New runtime option 'shared.memory' (or 'm') for toggling usage of shared memory (requires package synchronicity). CHANGES o some plots are -- finally -- generated using ggplot2 This adds an Imports dependency to ggplot2 and reshape2. BUG FIXES o fix a bug when running parallel NMF computation with algorithms defined in other packages (this most probably only affected my own packages, e.g., CellMix) ************************************************************************* Changes in version 0.17.1 ************************************************************************* CHANGES o Computations seeded with an NMF object now set slot @seed to 'NMF' o Added unit tests on seeding with an NMF object o Removed some obsolete comments BUG FIXES o an error was thrown when running multiple sequential NMF computations with nrun>=50: object '.MODE_SEQ' not found. (reported by Kenneth Lopiano) ************************************************************************* Changes in version 0.16.5 ************************************************************************* CHANGES o Now depends on pkgmaker 0.16 o Disabled shared memory on Mac machines by default, due to un-resolved bug that occurs with big-matrix descriptors. It can be restored using nmf.options(shared.memory=TRUE) o Package version is now shown on startup message o Re-enabled unit test checks on CRAN, using the new function pkgmaker::isCHECK, that definitely identifies if tests are run under R CMD check. ************************************************************************* * Changes in version 0.15.2 * ************************************************************************* NEW FEATURES o New function nmfObject() to update old versions of NMF objects, eg., saved on disk. o NMF strategies can now define default values for their parameters, eg., `seed` to associate them with a seeding method that is not the default method, `maxIter` to make default runs with more iterations (for algorithms defined as NMFStrategyIterative), or any other algorithm-specific parameter. o new general utility function hasArg2 that is identical to hasArg but takes the argument name as a character string, so that no check NOTE is thrown. CHANGES o All vignettes are now generated using knitr. o New dependency to pkgmaker which incorporated many of the general utility functions, initially defined for the NMF package. o example check is faster (as requested by CRAN) o the function selectMethodNMF was renamed into selectNMFMethod to be consistent with the other related *NMFMethod functions (get, set, etc..) FIXES o Fix computation of R-squared in profplot/corplot: now compute from a linear fit that includes an intercept. ************************************************************************* * Changes in version 0.8.6 * ************************************************************************* NEW FEATURES o Formula based NMF models that can incorporate fixed terms, which may be used to correct for covariates or define group specific offsets. CHANGES o Subsetting an NMF object with a single index now returns an NMF object, except if argument drop is not missing (i.e. either TRUE or FALSE). ************************************************************************* * Changes in version 0.6.03 * ************************************************************************* WARNING Due to the major changes made in the internal structure of the standard NMF models, previous NMF fits are not compatible with this version. NEW FEATURES o The factory function nmfModel has been enhanced and provides new methods that makes more easier the creation of NMF objects. See ?nmfModel. o A new heatmap drawing function 'aheatmap' (for annotated heatmap) is now used to generate the different heatmaps (basismap, coefmap and consensusmap). It is a enhancement/fork of the function pheatmap from package pheatmap and draw -- I think -- very nice heatmaps, providing a convenient and flexible interface to add annotation tracks to both the columns and rows, with sensible automatic legends. CHANGES o Method nmfModel when called with no arguments does not return anymore the list of available NMF models, but an empty NMF model. To list the available models, directly call `nmfModels()`. o The function `rmatrix` is now a S4 generic function. It gains methods for generating random matrices based on a template matrix or an NMF model. See ?rmatrix. o The function `rnmf` gains a method to generate a random NMF model given numerical dimensions. o The function nmfEstimateRank now returns the fits for each value of the rank in element 'fit' of the result list. See ?nmfEstimateRank. ************************************************************************* * Changes in version 0.5.3 * ************************************************************************* NEW FEATURES o The state of the random number generator is systematically stored in the 'NMFfit' object returned by function 'nmf'. It is stored in a new slot 'rng.seed' and can be access via the new method 'rngSeed' of class 'NMFfit'. See ?rngSeed for more details. o The number of cores to use in multicore computations can now also be specified by the 'p - parallel' runtime option (e.g. 'p4' to use 4 cores). Note that the value specified in option 'p' takes precedence on the one passed via argument '.pbackend'. See section 'Runtime options' in ?nmf for more details. o Function 'nmfApply' now allows values 3 and 4 for argument 'MARGIN' to apply a given function to the basis vectors (i.e. columns of the basis matrix W) and basis profiles (i.e. rows of the mixture coefficients H) respectively. See ?nmfApply for more details. o New S4 generic 'basiscor' and 'profcor' to compute the correlation matrices of the basis vectors and basis profiles respectively from two NMF models or from an NMF model and a given compatible matrix. See ?basiscor or ?profcor for more details. o New S4 generic 'fitcmp' to compare the NMF models fitted by two different runs of function 'nmf' (i.e. two 'NMFfit' objects). See ?fitcmp for more details. o New S4 generic 'canFit' that tells if an NMF method is able to exactly or partly fit a given NMF model. See ?canFit for more details. o New function 'selectMethodNMF' that selects an appropriate NMF method to fit a given NMF model. See ?selectMethodNMF for more details. o The verbosity level can be controlled more finely by the 'v - verbose' runtime option (e.g. using .options='v1' or 'v2'). The greater is the level the more information is printed. The verbose outputs have been cleaned-up and should be more consistent across the run mode (sequential or multicore). See section 'Runtime options' in ?nmf for more details. CHANGES o The standard update equations have been optimised further, by making them modify the factor matrices in place. This speeds up the computation and greatly improves the algorithms' memory footprint. o The package NMF now depends on the package digest that is used to display the state of random number generator in a concise way. o The methods 'metaHeatmap' are split into 3 new S4 generic 'basismap' to plot a heatmap of the basis matrix [formerly plotted by the call : 'metaHeatmap(object.of.class.NMF, 'features', ...) ], 'coefmap' to plot a heatmap of the mixture coefficient matrix [formerly plotted by the call : 'metaHeatmap(object.of.class.NMF, 'samples', ...) ], and 'consensusmap' to plot a heatmap of the consensus matrix associated with multiple runs of NMF [formerly plotted by the call : 'metaHeatmap(object.of.class.NMFfitX, ...) ]. BUG FIX o In factory method 'nmfModel': the colnames (resp. rownames) of matrix W (resp. H) are now correctly set when the rownames of H (resp. the colnames of W) are not null. NEWLY DEPRECATED CLASSES, METHODS, FUNCTIONS, DATA SETS o Deprecated Generics/Methods 1) 'metaHeatmap,NMF' and 'metaHeatmap,NMFfitX' - S4 methods remain with .Deprecated message. They are replaced by the definition of 3 new S4 generic 'basismap', 'coefmap' and 'consensusmap'. See the related point in section CHANGES above. They will be completely removed from the package in the next version. ************************************************************************* * Changes in version 0.5.1 * ************************************************************************* BUG FIX o fix a small bug in method 'rss' to allow argument 'target' to be a 'data.frame'. This was generating errors when computing the summary measures and especially when the function 'nmfEstimateRank' was called on a 'data.frame'. Thanks to Pavel Goldstein for reporting this. ************************************************************************* * Changes in version 0.5 * ************************************************************************* NEW FEATURES o Method 'fcnnls' provides a user-friendly interface for the internal function '.fcnnls' to solve non-nengative linear least square problems, using the fast combinatorial approach from Benthem and Keenan (2004). See '?fcnnls' for more details. o New argument 'callback' in method 'nmf' allows to provide a callback function when running multiple runs in default mode, that only keeps the best result. The callback function is applied to the result of each run before it possibly gets discarding. The results are stored in the miscellaneous slot '.callback' accessible via the '$' operator (e.g. res$.callback). See '?nmf' for more details. o New method 'niter' to retrieve the number of iterations performed to fit a NMF model. It is defined on objects of class 'NMFfit'. o New function 'isNMFfit' to check if an object is a result from NMF fitting. o New function 'rmatrix' to easily generate random matrices, and allow to specify the distribution from which the entries are drawn. For example: * 'rmatrix(100, 10)' generates a 100x10 matrix whose entries are drawn from the uniform distribution * 'rmatrix(100, 10, rnorm)' generates a 100x10 matrix whose entries are drawn from the standard Normal distribution. o New methods 'basisnames' and 'basisnames<-' to retrieve and set the basis vector names. See '?basisnames'. CHANGES o Add a CITATION file that provides the bibtex entries for citing the BMC Bioinformatics paper for the package (http://www.biomedcentral.com/1471-2105/11/367), the vignette and manual. See 'citation('NMF')' for complete references. o New argument 'ncol' in method 'nmfModel' to specify the target dimensions more easily by calls like 'nmfModel(r, n, p)' to create a r-rank NMF model that fits a n x p target matrix. o The subset method '[]' of objects of class 'NMF' has been changed to be more convenient. See BUG FIX o Method 'dimnames' for objects of class 'NMF' now correctly sets the names of each dimension. REMOVED CLASSES, METHODS, FUNCTIONS, DATA SETS o Method 'extra' has completely been removed. ************************************************************************* * Changes in version 0.4.8 * ************************************************************************* BUG FIX o When computing NMF with the SNMF/R(L) algorithms, an error could occur if a restart (recomputation of the initial value) for the H matrix (resp. W matrix) occured at the first iteration. Thanks to Joe Maisog for reporting this. ************************************************************************* * Changes in version 0.4.7 * ************************************************************************* BUG FIX o When computing the cophenetic correlation coefficient of a diagonal matrix, the 'cophcor' method was returning 'NA' with a warning from the 'cor' function. It now correctly returns 1. Thanks to Joe Maisog for reporting this. ************************************************************************* * Changes in version 0.4.4 * ************************************************************************* CHANGES o The major change is the explicit addition of the synchronicity package into the suggested package dependencies. Since the publication of versions 4.x of the bigmemory package, it is used by the NMF package to provide the mutex functionality required by multicore computations. Note This is relevant only for Linux/Mac-like platforms as the multicore package is not yet supported on MS Windows. Users using a recent version of the bigmemory package (i.e. >=4.x) DO NEED to install the synchronicity package to be able to run multicore NMF computations. Versions of bigmemory prior to 4.x include the mutex functionality. o Minor enhancement in error messages o Method 'nmfModel' can now be called with arguments 'rank' and 'target' swapped. This is for convenience and ease of use. BUG FIX o Argument 'RowSideColors' of the 'metaHeatmap' function is now correctly subset according to the value of argument 'filter'. However the argument must be named with its complete name 'RowSideColors', not assuming partial match. See KNOWN ISSUES. KNOWN ISSUES o In the 'metaHeatmap' function, when argument 'filter' is not 'FALSE': arguments 'RowSideColors', 'labRow', 'Rowv' that are intended to the 'heatmap.plus'-like function (and are used to label the rows) should be named using their complete name (i.e. not assuming partial match), otherwise the filtering is not applied to these argument and an error is generated. This issue will be fixed in a future release. ************************************************************************* * Changes in version 0.4.3 * ************************************************************************* CHANGES o function 'nmfEstimateRank' has been enhanced: -run options can be passed to each internal call to the 'nmf' function. See ?nmfEstiamteRank and ?nmf for details on the supported options. - a new argument 'stop' allows to run the estimation with fault tolerance, skipping runs that throw an error. Summary measures for these runs are set to NAs and a warning is thrown with details about the errors. o in function 'plot.NMF.rank': a new argument 'na.rm' allows to remove from the plots the ranks for which the measures are NAs (due to errors during the estimation process with 'nmfEstimateRank'). BUG FIX o Method 'consensus' is now exported in the NAMESPACE file. Thanks to Gang Su for reporting this. o Warnings and messages about loading packages are now suppressed. This was particularly confusing for users that do not have the packages and/or platform required for parallel computation: warnings were printed whereas the computation was -- sequentially -- performed without problem. Thanks to Joe Maisog for reporting this. ************************************************************************* * Changes in version 0.4.1 * ************************************************************************* BUG FIX o The 'metaHeatmap' function was not correctly handling row labels when argument filter was not FALSE. All usual row formating in heatmaps (label and ordering) are now working as expected. Thanks to Andreas Schlicker, from The Netherlands Cancer Institute for reporting this. o An error was thrown on some environments/platforms (e.g. Solaris) where not all the packages required for parallel computation were not available -- even when using option 'p' ('p' in lower case), which should have switched the computation to sequential. This is solved and the error is only thrown when running NMF with option 'P' (capital 'P'). o Not all the options were passed (e.g. 't' for tracking) in sequential mode (option '-p'). o verbose/debug global nmf.options were not restored if a numerical random seed were used. CHANGES o The 'metaHeatmap' function nows support passing the name of a filtering method in argument 'filter', which is passed to method 'extractFeatures'. See ?metaHeatmap. o Verbose and debug messages are better handled. When running a parallel computation of multiple runs, verbose messages from each run are shown only in debug mode. ************************************************************************* * Changes in version 0.4 * ************************************************************************* NEW FEATURES o Part of the code has been optimised in C++ for speed and memory efficiency: - the multiplicative updates for reducing the KL divergence and the euclidean distance have been optimised in C++. This significantly reduces the computation time of the methods that make use of them: 'lee', 'brunet', 'offset', 'nsNMF' and 'lnmf'. Old R version of the algorithm are still accessible with the suffix '.R#'. - the computation of euclidean distance and KL divergence are implemented in C++, and do not require the duplication of the original matrices as done in R. o Generic 'dimnames' is now defined for objects of class 'NMF' and returns a list with 3 elements: the row names of the basis matrix, the column names of the mixture coefficient matrix , and the column names of the basis matrix. This implies that methods 'rownames' and 'columnames' are also available for 'NMF' objects. o A new class structure has been developed to handle the results of multiple NMF runs in a cleaner and more structured way: - Class 'NMFfitX' defines a common interface for multiple NMF runs of a single algorithm. - Class 'NMFfitX1' handles the sub-case where only the best fit is returned. In particular, this class allows to handle such results as if coming from a single run. - Class 'NMFfitXn' handles the sub-case where the list of all the fits is returned. - Class 'NMFList' handles the case of heterogeneous NMF runs (different algorithms, different factorization rank, different dimension, etc...) o The vignette contains more examples and details about the use of package. o The package is compatible with both versions 3.x and 4.x of the bigmemory package. This package is used when running multicore parallel computations. With version 4.x of bigmemory, the synchronicity package is also required as it provides the mutex functionality that used to be provided by bigmemory 3.x. BUG FIX o Running in multicore mode from the GUI on MacOS X is not allowed anymore as it is not safe and were throwing an error ['The process has forked and ...']. Thanks to Stephen Henderson from the UCL Cancer Institute (UK) for reporting this. o Function 'nmf' now restores the random seed to its original value as before its call with a numeric seed. This behaviour can be disabled with option 'restore.seed=FALSE' or '-r' NEWLY DEPRECATED CLASSES, METHODS, FUNCTIONS, DATA SETS o Deprecated Generics/Methods 1) 'errorPlot' - S4 generic/methods remains with .Deprecated message. It is replaced by a definition of the 'plot' method for signatures 'NMFfit,missing' and 'NMFList,missing' It will be completely removed from the package in the next version. o Deprecated Class 1) 'NMFSet' - S4 class remains for backward compatibility, but is not used anymore. It is replaced by the classes 'NMFfitX1', 'NMFfitXn', 'NMFList'. ************************************************************************* * Changes in version 0.3 * ************************************************************************* NEW FEATURES o Now requires R 2.10 o New list slot 'misc' in class 'NMF' to be able to define new NMF models, without having to extend the S4 class. Access is done by methods '$' and '$<-'. o More robust and convenient interface 'nmf' o New built-in algorithm : PE-NMF [Zhang (2008)] o The vignette and documentation have been enriched with more examples and details on the functionalities. o When possible the computation is run in parallel on all the available cores. See option 'p' or 'parallel=TRUE' in argument '.options' of function 'nmf'. o Algorithms have been optimized and run faster o Plot for rank estimation: quality measure curves can be plotted together with a set of reference measures. The reference measures could for example come from the rank estimation of randomized data, to investigate overfitting. o New methods '$' and '$<-' to access slot 'extra' in class 'NMFfit' These methods replace method 'extra' that is now defunct. o Function 'randomize' allows to randomise a target matrix or 'ExpressionSet' by permuting the entries within each columns using a different permutation for each column. It is useful when checking for over-fitting. CHANGES o The 'random' method of class 'NMF' is renamed 'rnmf', but is still accessible through name 'random' via the 'seed' argument in the interface method 'nmf'. NEWLY DEFUNCT CLASSES, METHODS, FUNCTIONS, DATA SETS o Defunct Generics/Methods 1) 'extra' - S4 generic/methods remains with .Defunct message. It will be completely removed from the package in the next version. ************************************************************************* * Changes in version 0.2.4 * ************************************************************************* CHANGES o Class 'NMFStrategy' has a new slot 'mixed', that specify if the algorithm can handle mixed signed input matrices. o Method 'nmf-matrix,numeric,function' accepts a new parameter 'mixed' to specify if the custom algorithm can handle mixed signed input matrices. ************************************************************************* * Changes in version 0.2.3 * ************************************************************************* NEW FEATURES o Package 'Biobase' is not required anymore, and only suggested. The definition and export of the NMF-BioConductor layer is done at loading. o 'nmfApply' S4 generic/method: a 'apply'-like method for objects of class 'NMF'. o 'predict' S4 method for objects of class 'NMF': the method replace the now deprecated 'clusters' method. o 'featureNames' and 'sampleNames' S4 method for objects of class 'NMFSet'. o sub-setting S4 method '[' for objects of class 'NMF': row subsets are applied to the rows of the basis matrix, column subsets are applied to the columns of the mixture coefficient matrix. CHANGES o method 'featureScore' has a new argument 'method' to allow choosing between different scoring schema. o method 'extractFeatures' has two new arguments: 'method' allows choosing between different scoring and selection methods; 'format' allows to specify the output format. NOTE: the default output format has changed. The default result is now a list whose elements are integer vectors (one per basis component) that contain the indices of the basis-specific features. It is in practice what one is usually interested in. BUG FIXES o Methods 'basis<-' and 'coef<-' were not exported by file NAMESPACE. o Method 'featureNames' was returning the column names of the mixture coefficient matrix, instead of the row names of the basis matrix. o 'metaHeatmap' with argument 'class' set would throw an error. NEWLY DEPRECATED CLASSES, METHODS, FUNCTIONS, DATA SETS o Deprecated Generics/Methods 1) clusters - S4 generic/methods remain with .Deprecated message NMF/data/0000755000176000001440000000000012234465004011633 5ustar ripleyusersNMF/data/esGolub.rda0000644000176000001440000107763012234465004013741 0ustar ripleyusers7zXZi"6!Xs])TW"nRʟXg%>e@HrŽ԰5s.x *qjnqLlk$$(?{lR穯A|j%%ϸ5~KZ8 EZw i\KD2%HxK`2^f{ WDsDO=n6|~øWzyUX+. o9Kk9/j8ˆҏW]Z-E[Q>ǥJBN4%>C3٭ZhBYxu|S@c^[47 $(6L9Y k">m#i#`Fdt'`NRoļX6m4?㑣෮ߴ]>yY:̫XzS y!(ᚸjZ|=v$%517z\di6V5>09}Z$}O!pZ`L@xefOˡc t(Gf8eОDr/4[Dm&j ݰ,1aFMw]nvja9!hW?=٘#$#P()m*sNs$p,t>3IoZˊBH2b2-?]c-a-W_*-y a Yev=.N.d}v*+ ~6jD`ZT{2OJ;iln'Pwh!{՚^Jsv_IU[ A mAIEԂСa&ӷ2 ӋY|4PUIC c>" (Fg "tYSjូ>v/sYa67H UWK1ȑu,vUG7IjdO%L/WB+fF4q6f˗=%_YVN?gG2Ԛ\tXZ0W::pZHfo/Յjhn,3ԁ:UK |2ء 1ct  ׀V*[X4+hrZK& V%geMP:)-tg#+״b=)'vc DQ8WۉäIJQOpfV_?담1([Ho4/;*ZSVm9f*u MD~@*΄Ԛ.=j21۲^zSi\ EUQS MjrdR`#~ƜDn' bGvRk*"A;Bra4DF\nȾpj#&r,$ZndF7ȃg^qU.d )54ثX@ s}6?~;uIݧw?B;@RUɿ輓ՄI%QSֻj%-IyJaW')Q hT2A ΰ\9P]Qw}L]WG,73~V< a]ſ3Q(]VƳVAWؤ0¾GeQ;YKꚵ)OU)(v6my/خiv0 X7Y1ꥩvvG*8o{*ݡ}u=Q(0,=x ҡ3ÊUR6MLˆ}\;YX-3gG PH_FwXdgW|ֶD;;.UWBu(Zf>/@r5^;LxFz'tS+UwvrD%ΠTgbX)=Pky&p5Ц?",h(.&ksT"/.90D5 rr.<,eQ*5H 8%>SpSTNKIyӞ+uDB ЪIW3r*jQ=z; l6 #-L ՟]9Upq}`m]̝>r{X{\uʭ[4& JXsFFB@ګډ1!|pi.:yC7D|֕#yQ@2R @}^v)ld1[iv=PyY*ׄ |Dx=|ك_yo!)H*:Iݮ*̓Bi {ID)6y:2řO E|@E%P#o O>XV\ hMvUWJQQvܓLDŽ4l)Q_z7r0˕ Uݦ= ?xo4,:zdFbğW݋ёow \H;紆,[tqݩkM{i[ &WU FNk.U}HgnK|Вh~c+e+mD]&G6sA|>_s`-c[1?9@{ xa.QC,W:C2"\O9%` uYś9u-=~[ Տ6 WRnygzh+hkƦT2?:ػ<(=Œ=QTl֜3-zx$n蛁HI}ε=&ɏQ\w؛VG;הL̈߃}D9Wl -#BmaZkNEu߉tVưAˮHH=cg.\P~ا {ډnF_|ܐRJ+^> 6/<ޘ'ɒ(d 8ڮ["][=AV4o'h/X4'lY)3ܶ@-Jҿe)4dwB)tI@dm(D\Pɮ"ξ@ɜ214c݈.Ľ)un+-/szy4 ZkiBK/\NĚ <f|P<2bhc6JV/X+D踑\7pNUy OkM #i| CԷN ˌqթ1S qJ-`0"}*?fqr'_ʪp(-l!ysl fO-,)m6}b{!M(U qiLUz@AtTP>a*T"H1Hkmɭ}NE=21*Vhk#/)q8a NA@ "a_j]=y5:Ga#O :6r%6:G U(Ey՚ёu2:m@izryk΋ʼ3 è{Q$+Jgt}'5~q4j 2M L@W>^%-w2On Kȴtk;k,#;0d_wXF\A>9I³[T4ҊWm\.)%k fÂzH.]*riWO#хa)ұ ֿIAƃx9=|_rVApu]UYDʈo0\ds:&22Ć)JCI4tG:: %x%_fGzwe:6$[ 'H ɗ]9/B&o lCt1a-v?Fs]~ iV[[q]gϩcQ +BY匜W pVṡ6\I-4Ta&gNFstSjتs?킣qnyc\]JDNH˞[qMr ݗ8XR`btJ32ěp4X53 라a%n^4}`x~ OePGrmˏ 笩4B74 }J0lV{}|DŽ##VKwD߽ɳ*{C<甬qZLiW.zaQ?0\ J68 N!ཛJ^2 T`K(]& :l ZN~I\sd CcޅsIpA.Q>znHlE]jjy[/,s]cIl]xQDv8pb8 $J=ԫXV<cvkEl]V" uiaߣҙZ_1Z%m'l\},f#"Q_ w/ b}bK81/ ;BTr{e'N| Y29)|ֆ)s!.>y=An3c Gh>Ts6s`f\lT%0[ xIoH%20f#ǔu}3P2Diop<6 SU}q$P7g. n[P'UwbXL=j 3¤lY*;TܐQ׾,DBzJʘ_u%/3”]+U_ٲ UAtˆ[I~cEþJF ╇'#[P)"Y֦U#3ɑUW%|:#\JUˊ<H@"4QG1K'Ϋ1-zGyƗTI/Wnʘ7Abh'8͞ p@߇,Q귏PsYYCʘZ07gEG:Ġ^酸4XJ7/sZ a7I#ep!%?Az+3=GE`)gל Fô|mUb\p@Ti}!4F5ToSȈOPɾᐨpfA0POVt%;Wۇ[Fk*iqRuQRG~NyK07k>t~odC)`b >3/ $F8B=i:@*pMxn3Yv"~qTㄏ T 90X廖1t;,* rAwBt"_CMp\K6"J)n,? ={QC`l|^}s.p jŧ,ś Toci:H *U]ѡQDp Ư/ ?L^ i7f'Xȸ $q#ʧ$ ö́i% 70/IVBܰDp,ݘM%$iqnObk|5ׂ6,5Uջj>:ty}D1LFb]%݀ ݶ1sԸcsb'JK @;gqϻT7T%Fԯ&I3)MA2rڡ^&wR0 mQ,pZKQe)IKr};[A[agv| UOcrDatqFڬaL:3ҡ!74x2O=i6Vmb(/ދ>R_^ʙRbv촖zE"{Y]A>$ 5sVoÒ"w#0,>ظhsNCP-f,GLܽ xi0\ -IrLHQ 1uݭ81Uor 0(w8k%PQ ev|vOE L{;]%Y7Tr!'KdmFSF%Xq(iذUoNG]2v-uZ`@;=\Ɲd(cx7,bAFusFL͜}1$ '7xDaTءv׶A;̱ؕ\kymϟg}NBsiE|L>tEtkJGKC mU4]8xZNriYv퉊~qs;{W!Ϲũ͠ є+ y*JpO^{k[DWP ZV:l[X#QKJfx+SfG04FFzӴZM]e?}iDXWekYG}d!tr4%lP*$Z΢԰eGAo&!Wa b@JX +uWo,\t|y|Iy=oA5\H}KӇkMDqwo9bM!_GK* 0)^ǯ-F{FQ#\19MR6 GRW'9>7D:ov4dKЈyslgza#z}rKsƋrYג?1%X<̴do[h{KJ! )zVRUc4DW},w>ηsU-/3ȄSrF6["lb0W2i$\jʃ8?~}kU?,âV H=?[2ImCE`bV@'>B: 4#b~#@L9&S^.PTKj;k0Aܙ$@5I nO)"3 GAys*̔vޯwZ8p~P4ݜLLN9`)ǣ?ڲ7fޘguöHQG e?ERL%Z2;nb:@~GQT݀@~9 xy™<? !Ĝt1["Wn.o424Ls:jsC?z^J{&vV{%6ӓd[@' "4&iI[x:c_4 Ud # |\υ` uM*84W!iv9dF#ӂtŴw@Gnܷp2 /=qF*=Ϭj7?n7b'^cyYAu_AԦcC#G_a*2N%E};d0+Ɠd3~-Ji@Dbf$9e7*.Έv z\?(C./Mh l@Ze`BҪKSOPgin0mD:Zϭ2͎ ;_V?ԏX"r1t';`g[hQ  zpY']A5qmuz%8ʍ.j&#&u#/[ uub_'HΏ2c(*P`xn9*?1?VV:ޙ5+43Usap1R@u`Et:O.!]TVT'UPaz?|.!d Z= X}WR_l!,aR@vNn ɷ5^Y3]1Kw]b; Dgܯ5._4g u@'O2_`~=|J_ÌVd`KPJ9jLB^X+y4fCHϿfBXe O\Z feA0 3 *Y#XJ/*mQ}=͆@7%#EI`qN| hҧAh/Cg$fG9ȼIT u\ZLّ?rFkSp}P!>+[ U+|W%ȡoCaTGշqCͭ=GwB)xk>#[=.FR_r,ޚ$(\U><ޠ(aPl_Xh){:R&?(2=#a4+`=a?r!W[rC ezyA[E"iktj)l(sBO>ݢϚעd$bHx;\\K@Lg{uHm6UT~Qd#p-kXoWSQ&W!dM9<+ sqdDڌڱ8UujPyخ<&=@+ujQKTλçK2v9C\5+TZAj :Z_{{]l ,QPo4} &%݅bԿy ? k}\v}~f~7@)dm)'0|{XuˋA>冔g`d [Զ?Z_wT$}B~&n@ݎѥ10 |:" ۃ{9E9sľWזWgKǕ_Ydxb^AŜz麚7ar 艵y `!b-IJ8.sr)XFpspz}raQm ޻f+CCx1eϡ̚Q(cQT?UUʰq J,o@¹=Sb*F؟N󜥟s9O9.b" 4U-I|!N ~E ]~I?y'  >9c!76}p`BYcaoVXa8Mya<~/p B Zƛ_2_؇|rW 9җDȉkWzA͕7 D+I0i(OrWg0_$I~#e· / jq;#v0f [0qK\T@0Δ{I %Y#YK`%V8 d GEC$ѩ9GI0: +k͛U;M?u3|!C÷q['.w>ih/6!kɡc]dX'O~} 0^W/wpĬ>:tn! SHr)THOn/5I[A|[jc,c:d?栳#%.`7Gjs=5~3Ѱ9G-AjWjmh-"׊}4!p*ēfmwnV65UBָ>RzD3U#0|*+h^{Ƥ!*Ȕ6Yj06Bðvd+ !A:Yo @H'¢-u <6h6 HzvMVrL*l=h 2=E_!Ar&谒twxW;qAAR:jjT)Qc%!K=,|hMrOp oKNF ׆HFJۉ\_KMd?fN(%t lХ/,iHO-{!}Y5m#{3Fj VV}K)puոߌB׮UckK!ťQԶ(4M"S wq?FĿdSߊ@E*"Y)U%%5: 2?65H?UM&w >Wݵd柂x ʙ]֚òqWַ??aյ>_=UPn,x4V{-# 1Tfj9"GJ<8Gs<^>;3Up./>"l%?f?lakcȹ%,X RHw(|L46+ÚH,ii˳LCp)fT`Bix|N3**fG67CZ1hb.!JjXE.EwcdSx+eL_. pc7% '.> g,aCBZW̠6O\p$ nulf9FR݌[4ND#^v&@BT\ZFp~^L%!p>b6W53| y(j>@G4f4 T{+qo_C5S6?P4ƾj/]u~'x5C) @b֒]T5kiUpC^A 6 }}Ma3f VUbN_=fZP::xz$NF_=ǂ-T |׋{h:-(=Pe4KT{Dj2Q=Dj)Xa ^V-$|\:nӯ=A$[`\IN3&?3$=dPD<'$7-}l:M菃]$qH!\$1L R#zm`L.|wtZS([GQ̺2 z3[NIgf|x(Cedo 5bOn#i>1p+nu& "iJa!`k_pЉZ@Iay3 "ZoaM=,<'KKPLKi=e=pT#8W7 gAKi=h'ɏm[f2}'vTvwT;v 5}q[? 06PH@<`U?tc{g6ʾXeSԵn_zYOU_>۬ 9V#S"u@múB]tؘ=M yǶP6 SFO]=CfhĀ 1~-B_mD!K笥( J4O0Xj<;Y8)RFs,Jm(vOT+Ƀ%FyvaT omk*5-dD'xP^GjW EWt?#N1>Z߷9_Qt4@߾.z@L{E&|kGsaVBѸa=Ѥh Q$ HyA}3oj h#vӀo:?oF6fë\x*^DlLx&aUz' _2#J*$LveT8Xt9ZuV0oX li~Z(P. B"L]pE /X֜JJ0UA(UΊbvEN-"G ^p9̍+@^2HZU r}:+DZpTm s?:C =\k g ;oxP_O;vF7Z0LS xKOtbOH%>ȃ/*4 gƩH8KounPzH0voCA^*7<!bN"Nklkj UOXYlU9  `jkqJX5tid{zN'J|s0DZa䞋2+i';Ĺ`keo+:y`(QΚ-<V=d(ف#zL]=eMB`O8sYsՒ)ny1H 8Ę3A⧅|d*NU1`r=g f/cT,]~~9HzRJvQ*^ps̘|B=Tc(ƫ w'迳]ߞ,W8'%)08Ts!F<A뮥kv1o`~?ۊDѭ ^>kG9)Q(wd]02;E"ָ̊;#7=u>rfr ޴`z _Wk>B{ʲ<È⳶]dm/6yUS^*8P+c s bn ˋ1g(ޫh Vx!&eo, F? % !#j?>p|d׵6-KCm7,odKvFzAK1@* \4j9~MiFDדTzcMg!^!Ӽmxq5:LaqT (t:=nN_*>fjPLH38C5b7#wMB0K~ 0i?j8I5$= rۙ xfٕ:}+QO@|J#@z.S;c1Y"e&Gީ?$6ğ(KH\dr|K[!2PXG`RZWᐨ;ڎlŷ#$PB,>a KX6ĬMBbsS@J13hwN9<<^2i˵2xF<)YOʋi$reYHS ihO2bErRROVuhecڪ]q up&wա~}#; !$qпpBTqɵW7@2rCzDu]n(o G 4!;(d,4]>/x6}FfւofpTGV.'ZVB͡( 'p8/n-:Վԛpٸ"X`;[{|}fgԸt~;xѢf\9i)ƥȅ\ŷfOHd㟾\OOFC`iW# o C<摰6Ck3Y[풚'j;LOV}2 hxFl >=9U\&A\j*NMnc9Y D*8~ɑ{|Yޓ{W]nN; ;ȂIv w¼hUuC"AyW(0(SA%R5P4|wê^N=$F*|^|(Zʄ%UUk1jHX8#1glL=*"ҝix-E[і|BN.rO[ܾpJԹ[z [_"Cq*j%n+JYNni`8ڨNB!̨g_YyP^e:HDBP❷|?3])ubs\L]ۃ.sGj*2a3aqԅHyInǻ UZn!5"Di."#! !B s/.8tұд5 ]\CnZ #qȆ5#y}A+u[;EQɓ#/Aٙ!IDI)N`ZQ$j*Z| G_.]VkB7,Tmf%EC<^duL{Cmۧ"$b,_S3v(/N)yՂ ëC%"Mg0XMNrBϛ'|Y" ; x],6ZFd;_h"]FJa#aH=|D2زd\#)EwіA{kVy-9`p'=H4r(% Fj5> #&7; 86`zLoބH[ Go+y ̧_ zVD'qr_s xbe|1M0]ZG\!ФB3~~:sQ#%SڂxsoW&^/T>ÌC9"MRI~`_p!|ZW#,?eD **>qtSΫaSMl@'Rrk&_.a5ő]l2׭ ` (\=(H,m?L \o<i{yO:Њ ǥO.-7Y<-)6:Nĉiw ;MbtKOa/"UdyY|$'k*t@f"ORcy<ٻdH2iUT:er L'JY6t-" 8C;*,m`8h"I1 Uʹws؍pLd)E潣/pۺqح-dğ~#Ĝw9ͨLctr~|3.3˰/[x {ΑquB7b~tٻN  gdlFVɘ=E bZnuLtf˲\&d(Cܒm|;hH۸n&<LT !N+A]FѠ_nW298b}hWdȩURo m 6>s*-G8َ&Sv_3.!)%I͸2Е  ,v3a } LX*fxec GXMA@Nw<m 'pweILiwCV/ai5 L/pX-)owmSl _K ^j8ΊYJ%:) M3 Fύ0BRǯQ}vM0Ljmfء!V =UOi[w1'B?-*h^KLkq>wT4ԱwS@`-pҺlR6s#OuM++*/0V{v6m xM>ddP҇Wp.- cmtTeҜk8O2՚?蘰zRT|:='Uj^T(JwnXDY .`u9dZG'rDS\J9t^sT ]Al7s y|9y9JvAAMO *C̅|2uN=4  |uU6%7ڛp2rT 0J쭥 ;T&='遛F路UeLaA+%U܉,?+w!džw&x\}2eDp$RbHS\j|\p6 *g) /\v ! [15~_4wWTVd A,H  ћ%-1 ;y=x8գFOwYmX& ˰6]2 #U}Gt˜]dY[s |׷@0/v41&S̲잎MlSSD^.=9Du,a΁%uoig֧;9 owMzɤzy83AF]$G yl6; b !Aq7`)?*9Yos#*'v!GA![oR}O g87o$ G7|֫_v>5w_Dr.xIIN^o=: En㮖g$??jFzC5̌94fʸطwx[9:R3FT.dX5sW&K;Yv;[=L=-"4iT gq>$jy4#(`TM/F,sk-أq$P(Fl)ػb~8S:X t._?U%/U&f#¼>pFmJ*"+:fEWG|â{OB$ ?zX+ P\i}Ð0^ laSvxG8DVee>Ů8seL]y֪Z}}dn\qޓꕭ]ν !kpiM s)cX-u2BwCӎ|+_7U}V!u hUZx2߸U 68[[a^cPiiM xЩI K|ɠ/v՘[p3'b$hB ӏ:e9+$t<M-ϖX1/ӋuLZs,Da2vSux;M&v4F5H' QJzT '`}S>wD4!eGi_Z˨,%kH$֔hl@R%,(Qщ_ZEoRoa54žX;R5z Ԫ4XUvPP3:"س$T(oP1XD̗;\5E*RN7dBy bwRS6wtw6_WC{1ֺnTϽՎ2rjjUh91zAFȷ7Jj2|}L؊}iSDÈp u$S42Aryebj.ItƬ I03u|`!@iz0! AV/$< Fo|QͰ{CcU.KxxO(6WV9Z rۢ4紽 Cl۟W? d[ʒet˘&*]H /PP<Ռ2IY F$PY/(iwJۘ 3m7No]5 ^Jٕ `EgdM%bteT :͆I^AKn岢lW=Z礧o7 n,vKqŬ @??_#.t/ aoXLꖎ!ޏ qH ylget{[bZvfƮ|ؘkX>{eg.I~RBhBcƥ9PSmzP jFɨ;ae#5 kmqZvhZj6-tuyDrrő;%ddM$QYn8D9#g:lb0x6E7ъn/)ե7Z^Z,!ӂ2GC "*? 8G' TW}LpN#F'_l{"]%@8r<_}@Gҗq Qцmڵ73`͠MM)XCRJO@$sh.YA]2Ds^3ژ,Bw:sѠ :v\ޏ [z6N.Zn8 l/>؈Ȩؘa{YOzO EM8l<|T [;Mb? GV@S`L=5ioO-M X]Rĭ/͐ht&Vh1Mˤ^ r'>aQ$"x!y'L؎cmBb@ Q]m{ 1t/͸J͉޳S/C{!lAad,ʃ]с! W~dwDߗdSWB{N&D$^;rhoA#$N}QH2ݯ^ɰ?7C4m޲ԪHPŠ sn~s`IXR'y efSpv uS%w3H}a,$\CDt^X"y6LYrE8xdb=@"q+0#-7TQ&X?H@Hg_\I%3jRWA^VJ\nm[ep]+ m'B4p$L U终e#&m("yakM-(?>$h|v:YQ>bhE|A=2Rx:b^$,g*O sD}6-A!>"VQ ^;ꌱ jK=n3{"Ĕs3ԾZV]Zc[وa΋קy F%8^) jH֦iF9/[ѦCf`di =孁)̻.+C*O֌v-p3a`T$YD?EXE3TLY2ue Sv towlź0)GHJ/t[ٞ&A\xx{Ry𯄝}!ig]d:UC/l{55$jͻ2jfV]x# duD @ީAQ7;8rh57qUQvp޶Pt)K4`Ó96ĵW3׸.S D)hNR$ QMF=se Յ  vQYf4WrĤĜ}.`ÝcuQ_{rĦ VH=TQ6/E7H6:{!FzkX]ۙ7R-J5#n![/=--,ݟ/^t&hv\P>8!3Kp^; à,!.t,`TE\ު ^O_%{6šn0';z[+BZN6AƎYƹ705=/`7H[OZbt9)R5{dL0r1=4%n'ILؘ;L"bٗj܀Ta"tVEq+ƚT HBp\UD2o6;iRPcdaea! 61R[ܘpV]볫Z=w,wDDg[gcdYl$3T *nUj^Pe_gCE|`akϿɴz({LO_jILulVG '6:~z4΍_bo!_ T`(v^NK%+ 8[zaژT`@X{50ʇ2JUz$426FyCp[sG%4MlYRthXOt%3mu4^6\ClwNgZ[@i٘aZ@ aphH?z-b5i) z'mZP]mhդ;= /:l g.nK"fvjZGOOñ.i|:3=s*E"Z7 Qk?\.P~wZ0Q߉ kݿ"9$\:-akc:Nd?Pk-{W}3 r+?MQ_:oŽ*^ާSӌb" 5)6HO`FwI ҡ2wcgU[ Ռ5S?UA%&-ɏMܝNxS.t+m59NrǸbPL(l󊙶 K">|Rl0Y:iRO߫ O) Mp/$HgaVGq/m$5UUJ(e|L7ߡ˜%gWic4fm<6B_]$7+}pπ5o˴5qJPJW8oN[' @qIs ̛Mz :~k KVxQ L,skqӞFHRa/sL)hN$N]AQڊe|$[v&6H@(`~D漿 DX5݂q`R2+ ,7rG^Y^(7z<.9tg]ls'5+pk 9@hՓsse5%gQձj3 QIp:UmT ٭ѷ߂a$~b41ZA>{f fKː3^Oo㻆;9h4TuA9D7~!#rwQC{ReՊ!oG.VqdYx2.(g<\8$rJ闏6(sO @7+o- oc G.[.yrq4^F# :X{\Xs O5SlO/[ èF]Hݵڙ.J/ pj`Q= L{zFP;۾ 3Kq @IUJj~V'A),9o }Y=$c}x w×s AX" hRRr1vmG@f(z Jqli74f]KT$8D׽C Zuʒ;׉OBq۶/E~N*(7kMs-t{B[7 hRoJ ;J.S^-3|USZLbbʋ2ٸ|M@$c؉wzm8GUo+ȷ/4C(0~~a"C$ϳferHJ&'6=xF4lF^>|=u.(\:V$mՠ<&͹ yfX!yGӮTA|aN*Y_ u>١mka=7RPAE!آ`y"K>:-zPiG!0V)+A-|.d&[qG8L$tt6Re9f35^UXAbǪ0ÁXs4xn[4Q tCZu}d uD&`Ȱ(& Vާ JQ@5E4\޾y{YQZ^ uS@]ۢD PXP^'AHF|ӚW.Zgj7}fACFEo jsR]1+S6Vɻws.k /q/3m>?wŞG2Vu@gQMJ!Vyr| &9YxcߜM 8ԯ;̘8`ӅޖL%̦c+B@m4sK B.‘hb[Tv&FkTG:crI椹 :y qsWnqLnA XD>hf1\_)2,$ȴʅddTajLm.qp.RߺG0Viц'mfQdϜ7{욙/覑y5΂~@jF͔wd'ivS7% ͑*ҌxT).̍ qc/mu *?etKkH0{bbd6_) ZieI!99,I$XZ``곷dbSW}aoT4fy aW]Uyiؽ*xpw'UC=Z1cK&0jG5WlK2PG]gF.RKd`'aSRKQ^Y`L*Х #7> aUCem;:3NYvG͔_8;3ҬnRW.3¤ntˌn< ҂ZO{j Sf<×!r!8D٤V%ia6A>ʰd #j| xMqccu:UEs'j>TS)e(~}O./!7Dr]^M(=vZ_}>(%= Ƒ ݿQᅤag]=|3C"J3 R yebԑ.[Vb|gG¸ӟwѶ>%ڜ<zXU7 h$6}A\ cPtn/c4u @f--t5y5[֝3r6u˙Ssxo[e^)]}rk0G/ -Zm)>cUiK2ULikѲEaGCEgw*k~cp-!Y nWyKOCD}\,lQ [ {Mq eQT6C1'Ay3AtV\:<luxZ-vd=pȭigxO[Վ'E8< ;.H; z躕hQ_M'QB>gP]sm75G`BʲW (f<".4Knr^}4ZʄS|cTȄoE]<`\NU='$>tՀH]UwKb~VQ -V"e qډo`+dmwR'm33*^Q=oHm'"6$7Rɘ<7P͇'ezUB+%tٶ-_D] yj_#nimS>bcz(S_WJ$ʌJ5e M"g\+ErLLP.˪+X{~ɮa@b3=*6wIOu90EUL<ڡ8GΦv7(ޗN) j.脶tP7*HO Cu9aҒĐ mJ‰V rD(xSheʎ,Hλ&Ea:^w ab y1>ӻ {$߄>.k-!y">tOKLB=}9#)E2dwLYfG~3i1y52h͈)vǩloC3i\@WoffP-6vo¤HyQ`)>'Nq"f*NYE@8ݕӮ"z՗B++^4"d$,TVLcR1<]-l j sgpZ/X)ZT60 Ϙ _ $D_]y{;ִJ'a MB;r]&u|xXvYko1Q( Qe,lU%,`c # ս0ĮCܷ"0=B:StbċzVGN -|+{:%>0\+B *VFbG[N J۫ ;$jc VA:P҈+#V%fD~_!H~h[{m4wCw} (綪fj7Eg@/ DG4 AP $Hg'/]pN~n*?%nv]65n'#gBu :^nnUjMkIdTp @F_.K< #D'Pﳓ% DŽh he'z>-d 11qOc\ц{P#h0C~c_Z@jfٍ=/91 HT[WJN1wu^;xw.,snvK7%aM} Toݠ=_i@: ~}B6'#uTa}Ԡ(s-ϭ>Y? lrQ Bדejp!nן~$* Sa4cGX5Z)YWtJW`i#e2;̠C嶣`0 1|PJ(mFVŢc`|tgTxDQHkdoȹGaN.ltQ'Ԋݼw6󵓶-$p.iO钞"fDK`-PU,32{(?tCEt,aQӢ}zKqП멮̈́TnTܔ ${&Aw2YG]tOH2"wF#݇'%%vw/Țd3+D nʩma]AݣDoiGsZֱgbF"YVvdW_#&$m˰P+ܞ()?V暰.C@B,* |Z*)!KJQy mƠ^٘T]4GY;jk!+'H%:+4~VDcjNAjZj_}>B_{ #T/{T$1 :`+eTQUߴ?;ka+vZxH|;Jˆkiee6k}GOݠ=ps3)Yw,t6 #v!IwP4dn+Uɔ8J8=~(RZ)wi*sɨډs^FsqY9C5*ūSʕqhA-U7ϡ+Ib3) k&rwRwӰ H8#;!gXBW밻0R+/ yqæ4jW 8t&(jQ]ei҅LO[0I P |Zsޣ>"&F/Lu%#g]kECHECh[#uO JIA#@|:u<,wJ"P{£Q4昖i(*d; kXXf.R.FrtMUedodg1Ӫo6 Βʒ)RӃN2rͻ^0ѕmki7;SJd?6j^= |v+oF=H}ܿ~}t̻S!$Ɲ_3<o&{^$\2?A00lh݆aÂ繲l,pbR,P.xh!v*LVt_XRvN^AielMQ[ax v1=kjL߉PߋYtڭ~@u_.E_MC'>fzHj?/δL -Rɏ ȉECydXS[ܴ+#H w{d,p'|/3nG2㮜3Vܭ!$zBE}ԡ_"W337t\iԒ0VY9Gx/dA}ccᷔFld震A+XB.+B7gbQJT0|=<[< B|Cѭ{18v&5z?i8ȭ?A YdYXp_=sw)MFT 9no^2zXX¢* H$y$ zJ{Ga&Hy*䖄,h8]@N`*es !ABWKo\;eȇ;CYa. k&1lA]FV9w"e6ؕ@[WxoFO'nRK! Aiez!mFǰRuH 8.d>O\"Hf~D@X-k %QC⽦JF8DwS-|+]5-T1>W.i ]s/;6#DmYf)?AzOAF(w|N~k:4 ` 4Xh"a{益G"#5QMU孀Ě{$u=l_&SXѱ*\c-cCoA'MrCiG4 1(Mzo&J;i`zmMQ%h!KDG5ia7zgU7Oaٳ[Z˭CqS@w^A~}Pò>;*TVkz\$2O ~aPa ^4ʰZŒO;`RDP⩍;؈H"}zS4gq4j+a8 (#Maz ,=kLn1Ưvw8[l}ZQ_XF#QG uuI%bgd%hq?O QRGm=ڜ~*>QL@R=Sb0y@is7Kz;QduBX6cJ4pJh^ms*3drRz:cVE|FyWy@t{9A -fY,[J##R9N]*8U.F[5F}Uu>zjb ^N( o̴vYk_Rw)6,n"E׻ $(? &p+i?yՆӣ t:-!%sVH-FjԿ}[ 8[_nΚT3k$btŊQ [_gu۟Z9^iLG֔uFQl_j"rOw;<6H`TYbf/.wxK@z1ao]s(>tfh(W$k. (Cz2A6\H2?BRY_\&[Q?Qqm)ІXYW(*O32'OJڈ2c'm% j1e?m]7o<\6 )ky&XT:8~nEb:T| v oDE6s$y~M/^DBr랻#?C]3UPҟ6h3s]a}wT[~0ꥍ$RF2kM'q^`d-7ʶ~lj$ëp^Q|0c=vMR&LX!=}Iwz(Tz`X $ qe420vopґ PIZQ&lamU>%:uvkm0'*Z/+l֝5D\Z#*)zڐg@/3Fe0mȂHhN<5/VYw *R #oSCl4p_ L;ʄ ߊ DL !8e3V.4^Ր{FNqXUIBLAƇ9`*Kyj;,fߜ>WµBٞ.ytb"kE^Wz 3G/q•MDlXrj1 mYފsɶKΦdp;JxJ?U0>1 EU &f.vYF|cȮOǃ3UEFbA]&2eu?$f.r%}Zxn~qj{پ^0{(ɒfk9vx`vBwSRD19Y0M{Jix(7'{oD%ypӒ(ƋQe`T\͏ 8 2г u{1K<T~'&u[y;">esp>G,a-ORJzb@!ej4olL<5ݰ_!IۂHe'7xDZm__ROH/U0^'ݐlA: -R^)4bR:xfx*3B`ēѼs5 &X{[ \NnߘC-qok2 `Ct1B;|1^k>Ěqc7~"S/NS- P;R*Y#U,tSDj:T+%co%35=I%žg54y D`= G᲎-~yNV OJrҩ^0 3޹9˴ٙt~ M孙| bvVK n(6pKοVT+I B8jñjňSz_oxc>>2МjWo6'i19W$UnL")bZ^"E19vf1wTx|gU-ɛ8ě~m] ȰA`q7<_|Dv6T 䤝}v1X/3e IApc}d&̋dQES+2hD~ -QExrlP@$VZ82KkRYDI'{m4Q)?:د0nG]w գ9~S"،[^>;nhk-?)vNs~\2uZ`R;iQ*t"[4w6Guʞj+QEР`l:tQ G3|;1B=+@oLT'։[j!&TߎI\mܩj _M:FJKȭT*=Ti== 7S}+4q7 J3lmdtwNwN1DFMz@2AlyƧ G68?vb3[c!z:b|(Ok>uCZ-—M8_/^$[gu$A$nlAGa>kgfY`$ȲsQ)CJ7Amhb}4Iq7tNw i\jhe\sFZERPߏL'%PЛwZy5ƎJo2_~`c3naR TYE:-#ZSh!qlcխ=7(έ\_nGYhZ0S&l6%gx,u'oA $Q: ֝I{4'nK OPvvɸF|]WS2.q90g o|Mvnr(x`{'p7s/F{Z5bu2[\4muw, MWS L_1NJ'3'.IK4OQ`,EfD 噚fnRmx"5<3}Bc ھv7j&!3%}'y2mCZ[MR3x c+‹uT~#?;&[u ͲfkxAV/#3D-?MX::߈~,ˣ 1*Uh8"t4uݪ9wG&UT^?J=UQzrH\~iZ'#$׬;W@~[ocs܃vBeб27 oɈ]Ϲ,#0{LjS( 5`BJ X#;!XWXw+UQ CA &A&JXjUL7> 8~vom7XKa[iJ@E#P *)S3Yx(<ګawzpfgcFHz{c6}â<9Fz^J[$ۺ".9gD_M-GO&j6D4Q礲C乳Bfq"]TpM{F *俽<%__nߣ5}IY9WL<}zOB)_;Pϣ 免 f=)Ր$W_ ulm%QKɺ?_p_u{R6sso<Dng7SjW"U H/u[##tY0'?6%bbO{ÖWPWNs\:ڟB*沦 > +hO\qAkZ#@' jcH֎c+Κ×] |H=&kȋ n@QȦOFyRNݹďmЬ^RC1vLNk7ݷBSEXxnџP[>)-^dzv~̙aMf2 E ^U@ؑb]C5K̪+3 kNe{'7!hBoYYAz֭l'#J#R6ʀz)7} P/# m*pKm[T Tf  gll48]tg}V'&nD&)6IbhB%tPvb&;?5ߥos,>2${Hy6BleH{{oenދ~xqqh-Poq y5Z/K?.c4`(XLXv?sTT[K;|Ӕ?CMD @ bNx%+<@Q# Z 5|ScTq #h~xuYɻnKǞAeG+kèo_W)ekk:czԴkmܺx19CJ荠eЮ#xx%Wcy|F[ 57X$m[b`U@CwlS q)9k ^(+}ޣ@ R(BuP[7|y_b3 {o+L}L?3ca [}R?*uX &LEmSl7XlJplb=+; I]i>EN'n{y8F^n[o"vIJnE߾@u I5"^3?Rܶ+]A}*7n}YޠxjJ+ 5?>I c}43Jun3f^l%+ǫlGcZI/^_\n=+fN,j!_Ȳj:v҈R>0OkZ0I)$dp=9?i D5TA( X+?0SCV5϶,gφ(3jn%~)MMHȭ/ X'>\hG@^ P4d^pOŞ"͖*6Bfcpv#¸z02m /Ae{!@m=0v|vpq-}o>aMh?9׃EꢡQB;s#ZC2LJfNj`GI M+QaL]sѻ07M%DvP͟xNJV2 aU[+PpHX-jO B]cũ%ds`x[?uh:!5U[k c!u:b.R\:ZFU__]L E2Ʃ0ОTXG-f@.I_{Rspċ &WjkI'|xc9{`P@*gTF+r/vLzkƬ$ZYԾvcu5 +,٫dcVEiJfS/nOxW@n\Y7WЙӟLk]| K?"͒ 6UL楅։^.$@).A7dox3H azy;x7Kꍯb _% /6f_䞰 %p!S[=x''@d_L> Tn$rEߕN_S+ZBsX09:'KG.o;9kqQLo~IP1W]qU&4G7Hsw[RU|ҢȮ0q8Zo/!7F8b wؙW]WW224{_/ΉFYl& 9@~sЦ PSԘ_[Dg YsLEUCI=ۯ.E^&W!PM`ŃZ:iͱ5Gog6֏tl= Oȧ "߁W]JD$ `8͂~5w{i; \_l`'E"f'^s6\䌁\qW}*AbhŸv  Tjtfu,h#}؇kd]͝_-LVmO S@+#r֊GOG3sW{Orn? N (Lɓ1$n}*ܩ|@ͨ0q`c*X%FckN"߂be$P,]H"X,wfIYZrު={-G#9"VES Z_q?ۊşȞv5_z(YiD L)a1v*UiIâ]dW4 G;="FrFSђyG3gq S0N(~Rs*1o`ӵs1g4F7ebAٵ^S~ ~hr՗u+{4Išu06е '6= ԌA>=cJZJLM &: ?-Nvp侉)"RCT!Z>͞ kW|/λ/nVs~޽ɣvϛY.<\r6&ĮA\YVhOJw ىzfWBz vDN:K&ؕ![e[K.HVo^'*&9nع>AQ*7![n Iكw$QK,=?;/i"'B"%"ɐ6L[zp~THnV;ΩC]//)0x3P/z|@gs쓌M-;("m~9ߤ&UYuNff9ܦS+q+qv:4Z[G5eP1mП l ޶9 |7ӼӪ Xq* K6Cmm{g=!6z 8zgAzK:he$L7;)i,8fz&>MH/HXxxSb }/Du0nߗ߂o18ý(msi!@]gawipK'^s Ar hEꁊu%,0yp3-ﾐ7*oiE^y?D2zȾ6'3CtwZȗ+4Hd0M~NHތ Y4A7ט48 7V bGgk:dzw^2)+pe+a$f#:G&[OŦ<ɩ2$E#09oZ ssd= 1[ J|Î(.J>9 %#-Yxw +Z :B.4wΨhVߧrNxr4 5g|ĬxG~c!#bO3":wY M94@cj*6'ɦQåeU|MfZ{ztuOڅ%M? QI{ql7A[xE A&\a% 6?NR1 }nEFƜ"/ 2~y Pڞk~*[Iԍj#.t]ȂղGA.,i2wy "lْ:#SQ(w'@7s  uo6 y$B0w`#qi3i p!Ӓ%_g䒝5/E1L:0C98s>Rg1ю4mE⏩# nuUot{XۚW(_S=ro4x;`uRU:ӆi(nXTOTʘ;Z 34&g{i/B Uo ~LIq&*./L| ې5s*(1IIe\xk%K\!<';0h~aZCI M@G}ZU!u523#zFxy O{8.5$(yhvR:"]y&}R_6ɹ|}c6DÔ3^V]ޱFG6cv.w^x87U#gQ҈ CY%g yY MǧVOA74k&Ԓ+^t7~R&ʺyq1= >Oajt]BiV1sӱo}C6|J[.u {%iIX?rQTƒθom>:,L= n-c_ИuWV T'9U-߁*1wϻGV(*I ExT0?CZ%"6ڷ8&r󕃦klpxy{Zޞ$=I.Nbgk-Qkar)Ac&v阮jD!.bSOX((UՆEEfT4i;V6DW˝"5UH2tX͈YgZ߀abbQc*k2pֳНI?<#y!41@lIKE!lx54+E þZ d?Dk]WcAD0y̕E\E(TWTB([3ȘE,} ?Nxvmng%3([rI<|y ={xS"$lE\GZ8?VPd_:<1gG+ɮ%,0~sߒ}GnlMk1T Y#6Khjrmc!IVnTWS)~.`FxeΓT#R, {$ ǴnX=v0x ͬDJe/=2&h"?1i.%X3 KAUHFZ2/)? QNU%D4B3ftp+de1 ^2+R6n0A,Vb#+pK$v pdn!kL!Dm$-RkvP99)cxuiaʂ۶8 `wPY$;RS-z-{ҍso3R0jbmfD29* . 2@!:l(!uvrz'HKWXfaH&sP\44ݭ@H~k7Bj2\2vxr- %g7z|`ȡ0W pn|xϨ3fT&{Ҭ݆+#_v1P%'AAhq*&"D|qrvC [ud,ᾕ]5x㮹_]p3!*MEml.t#}4N |`uw7Q(. ܸikNRU b~zϲV3XeI}MФH;VYۯ*QcZm>ձL9ZLf.eH L"&\Մw5`I$tW]#/08}Awʠ}8(;i٧>2* 'j^XX_t>AO]u<8*rB~bmyyA-29.['frT#(Żaft$#FV9JKm;ٖ/a?e p(r(D"G~0 H'U IMOye%ɘ;hr.YTӀrRDXh<7k[y ߂l؎<@eFA]3Ksr 5$d)I.t, hVuaGvpeL-Fc)2aш[YwAhLj7ѧm6nOJ,cY#-5R~N&J_YB`ذ5&Fbvn꾈H l``N";)93m5 <09Y7/cfGD6An YKI|h|[/iNE˸$|Xk;=]&>:O&J>3oN2:X&_'IZ2o-L]+BgWD0\MjEsk +MO:/;nDmBbK7i^BRv3!;y>l!#9cXs1 .Niz@ b[ed\+ۤaXrJTJP+}G;x"'>+Di42":y"+~u7XW꼖+ fޠO91w2y+-c0_ 81sVHT? )&P5Vݜb(gzu^5?z)\~V^y AC9AVO?H }5v2GqRNe7!>O*TɷPxa2o9iO@ h\="n?3Y:Ҋ#,5\(x QgE&uB&Is;& Qy1P! Ca{Z2T4ﺛ(3;:LjȀO!'CªgAሴޡx,@➃8fwlpgV TцhFFj.=XiSpJ^j*!Tgpg$l  NZJyylڃ|-RNrE U~f6?>]JV9ԉ7d,7݂̪\BzeJv}aJ11ukrm\+ytT<z©TOγdyܽmEEiKE:)od!- ă%a^?d %okZf}, rk6XBWx7+fޚj0ʯM,tWLw凨.َJv^!Ӎkmz6LcYk+LЍtgSȱb!g)}vḱ6̺;˓gsaBG2];uJ'Og.v<8} WTT& u'a^ aQyW3PN#+TI?BOG/o:=4yz"jZ.޼΃_9ݙA|57ۊIy(h*3:7179U=ue0E7WY2'y{vtn)1"$U+! pBeͧIPc8 GB&QMd䘿ci./¦[ ֯`/Lǩv;u.ɇݍ~hlUgș1Ta/W* ІqGXzQ˦%ɀHXNv/xx R՛NQTvtldF$]a-SEnuXZՅ=w@nr@8"hst@Ǟ?> ª׳:)Y,~/+: vG$P!O'rF~Ң{з?g`&͹0 |p8辳;"?Γ\<ԏ. e RfBNL90sQ6rtzS"÷^HF*vZAIhӑ>CYw{5Y7&m+j8Ͽx۝9qL9>vgIؙZ_jtb;G9\v 1z6{kf{OG̐JHrS(I^Q2bnm^pb3#Oɡ䦶xaZo*ħuPnprt08wa1_Zu!|I !! 봧&2XVtC_溺I%RYF_e]٦t Ę'֞KcKuuoc+TxgTKfV5ɏ)n| U./{Q]Sy{ ^]NsyثKjazge-8PL0frE ˹Z ~DqsFל}W=Ow? }s2]v8Ap=TH [&돯C,E9qg~Mo:UBVY" !A9jV:~6GR<lt$G{0vѭ.X/F6<  ]aPc\oNBBextIq|8Eaa3!iniH'ߦ~{Cἶ>GH7tÕ nVYOrv'-~Iyo*CssU^¯Xh=4sy|KCҹ4P#U.L PLɧVد㒝$FA-t#~@|C^VnҾg̨\NdE[.fq[vnEmh8 -hi7J27K03M){^$rk$le})e!^h&HʪW.W,AX̧uAZ1Y#(D$,L?o'Ҝs rt&ѫ*hDb.F{ڛmF_j]<`|?C׶m*ׄ"&B즸Tޞjm6nQ_NO;VE\i{q *s~yp6a?ikkyC؁fp͘Looc)j4J@U R#.ώ Jاj¡<`P}YNl {^+V6:J&MȢIR߰|)E okza\KP{r %G/68cW#U&\6Uv5 (Qt]_h,|{Q@FtQb4"Z+|1?&<.sbXig3ha=hrr?-[s穹\$5gE>i+ΚNɐXk6 .=/Uej0L( ;v{`?[b:ǟ`m6k =oQ\Yt7:<ݰߜ%%iW6qRq֟`:i Lr㉜~!]+auL4Pٝp5Q%9[ɁB-bVePQMgq\؇(bYz{KZ,$@ea*j"֎G̘) R[ #hO&v^4nam{j$KPEu4`w>*OVECu/Bib-m5'7L"ݺeAc}2 07]o0: tf;_uٳ&替4ҋs ɑ ]Tg9Mƣ持Qʏ*ꜟ]F) IVx'N Riyrn)X{tɳqQnXIwQ\710ZkJ$Qw,= >1îK 5zLiT`ܖ|-1!ԅ@(zYj}!?6#Dmz#g:36ڷ%AfDVjtH7C| C9ɘ bH%Osܦs]"v_2IZZ^/G?}$xe1?wˀYCNHO_V.çaYh_2*:BW&Z&; ,{l,V̞!0聾}Ϋ(?P[͗UM5@Wk+2] tIu`H5 ܥ JcaH bIled 4/8#C,Pcy S_m]nuHTWCx/Ihk+f.(Y#@`40 M ci kݟnB}s%| #݈0˿P#.1g+ kܓj`61&D؋+6;{4nCk) !WU{^GjtǾ[J =ole׺(W,mI,k q8\A.f""R,YHRMIV7`޴9@CFyF/Zp>cweFZslmVdvV!󋋭ߖfW;`% jYLa;0T)^-uF|ۖ5E_zVO t$/ޡDDl\ -RL aR} QEy[>d2{ '{ nMZ+ E<'~"+뉘]:1BHۦ򐪢AöWeꋸ6ʎU$-`ձ 3zLuP@ɣ KW/: ~\@֌0DۥEs(f"o^/1K4,N=O]ϮЂjH}8+S|,,۱;݈xR*S;‹J.<ޚtɵ6cNmf2iul{DY[:/ >Ls5\%5ėN]p+0 -٫pʐ9oѕY@]4vb`4%4EٗY!.`fGSO€{@woKm1vMu !=VgMW6c_V Qπ$=z3Rc0UeEb1R )0#`o+3WauVr 5c+TrvEπp>;ϷC'0HyzeK|s.,͒˕`/WlQefkeSX7Ɛ|03E1V{,""&=a}wެKe~-"wP)>_9DQrhhHkulvSj4rxV;0*z/͂߳#I9 .O"? g6 Yg} -X/xLu$>~c4OS*/ϩ8vEtg'PpL]!<7%O=ӢS= ir> ϮCm@qJwg )bDu;c2O,l$-3l㝖;9lU#R7э\V]^xN{[A(lG'gyo!qdl% a7r ҶZZ N$oXb3zMy_3kZD*ԼS#e!c9f8vd߬i,`HB`X. VO cg"yY(p;)Sœy}g7:\"RL^Z-lYcE!ME ,N )V(.I lurQlP)ܬAO 744#4A"7Pw{gJ=gf>Is!/ƭPĦ5MS+[/dtjv;FՐ {#Ș& X"Ntp7*(3n=UokxcqM(辘 0m6ڡ@> }f+R,;'2Ro7Yܴ%j+&ʜ2Yl=GqCܠoK}D=7ךSK0Ɨ3.o̽ؗ~%_ y?nI7;mCj/U8,~Ij>W-=h!ۊ%C6~3Vy/ts#L59C|=f}m-op#uXZ`<@)<>_Ykw[ 'aASQ^P%d7q|Ҏā!t4F~~n;q$}B;L(~w=#F^#̙Q~i2N˫D҆ERSnzMknr;PHl :e"H([Gpl\ۛ?=sd( l=YO+\(`m%l՚Bb-)VOj8՗Vy@~Wsrrݞ>>`R&n~̗z{#F9-tet;~z?E3!au%b&ੈv3}J-\񘽔R[x[Kj,&!j"JuC(PXtkFi.w <#94'vek'dY'̍l&# 7!B$Z?hɲ 8=f$ B=6BXkg^pw|]R̸ RQ;LbɇRݴO/v֞q JVUa GS4)eK ~ѼS,O '\4Kp?nnK7BpΪ+-_mGvd@mOc-nd&}'ؓ *^s\/b,9s(Ɨ 6%mNz%::[arN{8F t_ SkWv1A5xv}6^ jΊVFmրWK:5R|$'xVHw7M̏[&sax 9=L}PS_0e}}4OphSkO$N\= c&k2nKd\ n{97 ƱOMK'܈봴hӥo:3? ]Ťw2[=]Khjj xl#\D猓Fu~Ͽ&Ta#q8]_1EXNEFr>ZU3=!QUsȔG6Q|Si޻05  ΫSflqy] ?Eq+ќ :B,4d^<zMn${! ۬w7]F 6>m=׊-|Г_fSm~9POqИjxFJ+2pc┚yd'uoс:Ў55xޗf<tHZ ?V%l JST8Ry1924+%yī[7噁u1f+FariIi{M ?VYlB `or =GY _5kF!4e l`*E5V$~ߖQ9P5; (H Ω M%$'r)?ë(݃2clo ·s1}ݑQYO7{\+brw()^j|&4|,\"0l"nuybv`o&* :b|ngO[>:1"> ,b\68q~+ު?_\6`/{'OdžFЕ$Sfٻ4Kf޾%0 !מz&ҷiks.@&a* -ӈKͦ8fNݐKsIA>NW(AfB1+<;Y5(e9)LI,3mx׋_[3CQU") giiěT0& q^^BmרDzȽ xPF ^2G{<lVEީ' ~$ ejЩW;6]O7sNFН%xHPRVV;ŸQ].bϕ(F*ڐ,\θd䰑Jl%ʭ5ɉ 6vdD25""eZ bT_yn^<%cdT(o)bl60.<3I;}DHy"ME{O8v<8Q53S!)yXKV?V >"eј/P9xw4YkkAS GC{͕oxG'h /\n(*:,& JBMf>@"ml{KWM`50 nW>eKu$-U*h.*ؕݓ5 )_o` =IվW௢nbP4㮒wgڸ!" Re|)<`o׻$xqTHc +߄[ s~C\ଋNa&x.KY`s/|%IWo٪CS""z5VyD36<Ѹt=<E[4S m&U'LbFaM!$6gŧuDc0Y5(hdV&CrOcqëkZ zks+,i~PplL0R/>$pc8KpJLi]Ӯ3X"kY2{%n(?j_TD7+gs(ٝ Zrjf-_#=G+3u[T2#a~6(!E쵟$%+<_g̠ۿʑ[o.jY?8j(^P :bb׆[KfC@AމV#b$RO3ƍ1Y+ZGѴx.a4+9DGI\"o=7'PKu{^7V;΃PxZ74aqزqG oXN4`)i#ÚEpofM_% qᢉn܍L5))[dc'=/ #j*ҷPi1 MG{~khɛh @wmkgT _};iOvux5O]4~5kp *`^ `G0uQ¼u .2##*`cIVUL' hd~3qݜ1UC5 :XmG8-޻]qoFϭB~XxK VIy}"ՑVy%&3;,ș mmIK FxLt)=\i((\% g`#Oddc={&.KdRD,Mpdˈq)d)%ic[f^V_ssLo,{݆KK.,3QYY_OBnxE DD'dϜ5/S\T n{Ti7Эn=9&NY}}pVyqlIO ,VH|xNy{F]흶'/qrkvl@^=;lP;O@[VZIx-x G5μ;f:j8Y}dd/ 2}Xd 4 6cTtV;nS6xhh=ºgY}SY3;law Ee-wu&]C"ܪ8LgL[GKVU~HZ|}?,Z@6+EZE.m!չ=sukl]B{Ԕq SE>;7BAP (eQۄvƱEqc͔1m^pI8 7V|4owUvJ:vv.0fW /h4Ge< Ej#[n߽ f|HXRNY[-!d*^sI4Y\P5rI\(0(ps |вו;wZ,lnxGo NXww{ҥn$ʢmCS+L^oXY56/nXI??ZE|m =^T*9 pE*X)̉@zOh>HdoIqq 攌5Nf |;IR(h].lW%Q#;m m+r EgvP8L)NX_.}w7U.(2x+ǖj 7mԬeG=wɆב<9j_~ټ&Ɋ4~#U/l'Ļ; ,v^^4lȾ^v D#d`]d޿xz%#[~cBip~gFِVNʭk7A=ڴ%aIr\[WV! B0k&$>9'MSODib$x \6:yris%6{*[kMeLk~C*<ۅ6 W^M鞳aWxVn5 oc/q7I~=+rS~ Ѥ; Q!$zYn;Kѿtp fdfKH cP#:M_dXo )`grd{_블_FVќ'Pc&")*j}l#5E'Spe&ix⽎OUm_2]ʣlf!䨤}v`n@Jzr?-&^+}k.?s],{"֣2/JxC3#[b̧{;hz\QQwz^#0hadI.ad.MS'~ƱuhPkVGok!Y~+.[c"*eK66n?U%6Х'qLd /4Fu OvⒹs0Wgf$xVbvY&_*R b 'ﳆ8R:" Y{JA^5L/-Ď Mp"RU?Nj/W;կ=~dVT QL¸c$ #D#4V9HhK!b׫3jUpW_U~x ZFK0Rfun EH/` *LO#4kl YT,a"b pPw1 4^,#_CH;6;'CPq㱰q>̀3`m _X !'BTTج }䛴| Ӵ,x;(\jKrWo(3f[5P0y~`ʼSZ@> 3d <5VK=N=O%-e]fY}  kړ"lUrlt{F`Un$ a*Rs`0ɯQ!>2"D2+6$rw pi Y)ko=@ u[k2 ifC";j췃FZ:*ombp`fJd7A Ã3Sߣ˞0%;f Xc{inP!M8 }Ҏq X=Zy}v'V WB[]OW* R1zbEo.rC.⁐y:WFNCOJjpUd~Н>lahL_w}翚,xMPr9}ΧO? Nh16c5n""/#ߋCp`y ɸ XѲMlޚmoSˬMd(ro a$WZEWT.G4nliiolADNz/;TV>pL-ƣθL?եt}YVqmB #ԡGlv?Wzqż" ͋>a-܊숐>Z\RBD>yY%[ 8"r/K:]X[/DFյ &[ДRbՃf+UEkD{8Yub$1,8 A"ByiR}j{D?-tp4nה];#r6 !n`~ 2X2T :>"(Ȓ)j!BcA|2P@mNs4qn1\vZhmI*HJM \q|=ݭlXV^↙?]'-tgo='LfHP(ȟ |C4YP7S*[ )Z+l4~gIz0تth11,Cч?k<zzO .Rq0KFӦt-@U?{˒Ȓq{)uM2.yPT'^J:/ssm16-V+Qҩ%2TI9k׈:-,T3S:FKsݢҜ@b,o8cRI֬<\qPQLS_RM"EU?&fO~EMCs.BZ6A/s&Rp ݃xk*"G,giW>gQ1B{V.(4LUğcm-Xgςjѡ|e cT!6`sOYmAHΊ>17i8>én?~Pq.?pOWS/2sf6) UAR{K|Jnx S)(sFhU$@9_Vx4?`FvAΔX~eHרo=W'J=xό+xUf~\n3$\PЭ2o`+1o%d =)&ʹ=3iBR ~+b}43"'N֞cGO6aY\#+q/'[pcJ%Σ7}#"Rny8e8+l1P3֜۱PKItPrknc31]+×$kRM&9 -5M:gVBLk`gkoi>U` 񙠩Rnq;V-JDq;ͰJO׆Py'o&@Buw^F@QZuUXH* n(VvZ1!2*L_lR=esyrǭ8tel%/^I)Ev+4zCWb+65rV2x[lnk5lCRB6I gI,׼ˠbm{`d跓pi@vvw;֎kTeCsιAn{Z,c-5O hS6<*4\%>qnvyrؾQ&ꉏZR2 ДZ' WgL֣LeOzG9,/.CԚ6*Z?gX4?vrc$^.ʳ'&DLpE&jj^LsY];d*T. U7e&myr £5.w\⊍|a t}` *rmmoz1J٣P[y m9[yaj*g9"eN/ C|_ |ZnZD4{rif+S3ϽN=7:|>_62ڧ5E~pXU}nج X\eX\OWTv|e@pNJ} '5جb}N:]]c"XC5vv q:B?#$?ό6BRŦbcw+q貌jè1B%`GNDbRX|n[} phpֲ< #|@|@WuGU"}Pl8'zlqfgHyK9NAԿq16sn U~!BUQvB-L{PX]}k"nGi5mlDॢԋ:Js: D{+uz7ymʔ!+m>;(^ ;SDV'e̿f1mE0ȓ)$衎cKWlihN5!&:HRsyI]PflJVE}Ӹ5ST/?ѯ1G2@<esz|o|DmqǢ #yj14cɝi:jXiJ9تn8u!2r~ZѾZ{ +%25Ǖo*o8*CdS@-Mo+&ttJ 38f.qST77ZHm4bV> )U[.ㄸ@ljXD_}i{i8n>W?R5gU\Lx. x |v!YцM 9^)%6mSEyєd >:\1^_^zN쇫PaU{HrOQIXG%ϵ}!EGuO:nl_}L]wi-Yi(tG馻INL"{DA)ЦS,aFO92 tIʜ5Yj@ע inPmXaVV-6%&IP.xz3{oL؃f0><8d ]`zKhH"X]=CaU q|XT DZm|z``XU)s%S'`BUxϳtGeue>yX M z Z58!L-vĭş+ǟa8Xuщ;r>w[{19Wukƍ~\wUkw8ѯ>[CA0݌Q P($ƩUxoD@>'Ptԛz-!!,*TRG;ui*=LWh*OA>@D'nAu6?xm0A>µ9*}RHNq;}DŽG%vťa@|Coo[*1"ӖQC1?b_^В9iICu0Λ\%[ 7 UI4 gŃf -cu܆!wB6uD,  {ɽ<Us~!- VH& f0p.P714B.ǓHq8@U7p8v8vX,Z&Bm駋Q`Aj<%.|n?>7jšn&.{تm›SχCa\>AmuskɌ/iȌOi6|0 <Ć*Gw-lmp X;r<OUPweA[PRFee 5w=/6;Bgr/pٹ%FK u'uYV1 QݓZUe +b#ZpWf)э~B4Wt΢~˗VXUaJ cx4x~@Mo=YWKswI8Ewֹ3e\b'h+i}zWuyG4Wx4G8G~\"etfJՂo,$fGk޴W3Y۱mw #%;ru. xC%yL_]fh\#Sf\VR ~ΠדFdAM\lbpt{OHcJ?pD+PMSܑ j%0==o'XL:lQvWNuKDJ"%Yr 5ICƸ1Ehabf;1T6X?Sex3稾USSjKN<+4r:ݹduJ+?dVE:YVAsh7TG;f  P|WD m!yLKעl387`g8b`\.Hrt }kf[1²xz= 5`DCFfO0=^Bu,3 c̀ǙwuyGtn1{hS&=@fHoe_b[K1H%gZ2+ؚXh%ZgTiW'[ !U#P7+ H E:č}wa .ݨ8á+J' IDZb|"2^.jq܆#Rv&x| s1cۅ^~;!ե\)]lI ܒuR/E z0 0f]R^-QO~]Q)u;cQ%sdiD.d셺q/5 Om&.Ij㦩,_ԛicI,׾)iC g!ƵY4Iyz廘!iWr \QGX )!f~0F *yr }y!x]}7wo4[  r{u=(2椲cF.72ecm=D-rNaسyʕQ H[/ Bh?6SUQ4t^uAul+ZAeS R Q07<;|-Uę*$bUGcV1@0J)p!F[:dOpV!Dr,e/p.w+tUۭ03GHl\luAv$`G`| 84-Z*άaeE ߊxU8:4G// L7_#G>[F;w Zzx ykr( y9ЁoʕB2r [*Zo߱;CtM)*gjv/5Eߚ0&+(+Ȑ9e(wf}W}P#KXa(6KկvJKȻqaHHKU2UJ3pGJ$lb.y>UkvO $90xlk&0^(ۥ5h&O[QMiDU AL/eTmqUdxnqTu!ѵ2'8׌U]*.23 ?=Tog;p4=hr͙pYvHT4Zb#a7y؈Ȍ1ҷr0jXbS[z h2 h-?2~F1'Y ER3e(FVk%LA|e Mh+Yp $`kq()RMP0jN8$)du[bւVmOJFzR@4wdmz# 0Jv}Hܲhƚ|cnNvxNd/𜉱K<)'#q‰3v6p!ٜ|]k 'p(%譿2)Y& (Ffm<ܫG (Hw`TJ}Ր׌~4Į%{ca9Փ}! j;`% !cѻfա K͟Wdsi~BSN*9ğH}_WO; oI>cu{!UF$)Xv›xKuصJq7Aޫ>{;𡅻IPҿ1AO bdd w>u>G~$ytZ}bf5<;z2[vi07c&b[8 F?/e9"cb7^fSŵM񨯱lNid>sk@XM!OW 0b3{?%0?O-qC˽{u:JvcJ! @h0q"ӜmºFN̚{-:6.㵃հUH Q|)MnvGLϛZIJE{ yt%vwt*Dp].NJn!Tv;MHwN}h2Z`QۃH\X1VO_|ԁ_ǒ1*)-9ɧzNQv|zm:OY5dJDpNU1IJHUB\&Ea=0e!H2"./7s/lVsvvN܇ @ &mlFR?LefMhAu1sp5$D i+VCޤeKd6!VE|+%yavHyMh\b!;~gkH/!vAF5pCt7O7 ?_J-b}'HE HVϠț7ZJr<*8 9lQJI.Cd Sa7Ɖ, ]?>oz&"%L+c]6BJc+@xqN yqLܒ֢a#B:u'8,*oIߍ30{= T\)@1BFl+{Zùo5.oceH:!| 89P8ū\V⓿Klwk_z|[\7k[ЧS=| wWU_tWA )ik^$sw, 5sGT0}#M+ffLJp˽V!},Rjrka-U~)ATfUQ(%9?o8Ű-Q0I{tѪZ0 nQ9[T}ۈd0ZIjeI]'[ MeۿK `rTP}9,9qwط~E>(r2[8woaz LocbjV;>r"].nY&b_OKpM/Cks{kef-("SťAh $֬!;g}q\y2;(w^UuY 5茎|_ gRi't"I)ˈC3 y^g §0s%h3P Sȿb 4; )ež.AOjzr3`RyְEK.\Kba^ 3g5hq,v F+HUDeџx\t*aHE (nm.rD%3h5(<~%RH#g>`oV.\\`̫?u.XN#!iKiq?M47P4sJ3-B8\c7AJ2Ą½WI_vQMꃃI7j+k 5j_g2vwU ٍ?Hi'Ӧ5rL̋Ἰy(!mA2.B_+9Lo\U iOa S'^k TQ$/TVP~èOe^^Ƭh9||4W|]c0_| 69v *t=i`.ˑ D_NoN5\.H!'kCD>2h5x8BP5a{ [A5J{ l)\8dvj%X+F@Ҽh<oIx@~i9RQ4 6Y8`HKwÝ/T>\߃_2A!V5#Vo}vp[|9;vV龁iY!ks1g2`%,-)6&ž$Z\,b–!yˍc'LZfrRѾ3A-<1ȄnNm H6>O<FK8 Yb j9X.[51qBZ7νM1YliY|٪^ 4a.vÙĶGkOF eAzๆm4+D-mNtu!>2OYw+yK5 ]J@ [h%8B^yگcnubwU9xӤ N[~H]EKqx][_0}P:@讬eH87MfhZc94ܱ)fjnUx&\&t V;g:UonoԬO洤MX(AoAR Ѩ(Rڥ4bcHL7]Z@⚙wOB|xGτʉ>l0D^]`zk|euc:+_I]OmGt*̪Km8tlzM 33VYQ)[FmA,g[+_I՛%gm sRwfw&1reN_>a-G[Oz y/T5\"ug72B|BVມ:^](4α mYrdVhc˚vHp֚/=3'k\3?4Zk`,f8͐-xODeGO_#2Nπ|hd'M("oE/<63 YA5_O)Oh%mOZ p)pc9DA.??WɦM#(bW`%Q+'V!%hC6 ʰ0:.o-W>Ø.f$&+reM1j$dm{!9B(Z\ FJ<}|7R.U3TKٓbqj"kdoSX(+a"W% 3Q/VH|\}QtJ=X9P :!mҐH<;e7DSCrqey6m{Vb~^L*iM:DJخ":eɔ*P Ko9DgI]Z3+J$'HDby%,2s5rQnHM:.TF3 Y;˖iSb_r&+Ԗ8ܷMB%Iv #cH2u[sя#hp!hTHjke~5aBbuwyE@!?+U/Mh ]JϟcVdoy`㡈j<xB롗{@؀]3!_()=<5;J8Xľ2 5 I` JXwی QU-[U@`eV>z>xvb^TQFg~n{^fhdby'bHn~ds>ԤJoJ=I:֧h2W2([fx*_} }iۜ&ain"ޔD!/H߿,r`X e65Kw pk)MM|* [=^A"]iY >TΡ@,3k(E7<tGO$N|*gHzr!+cowPƙ+Fn8|XД‰JBeyqipc߃y: <;귻A ރ9T}ldF!; b߶@.d5,H9᳐)aT&5@jx]1ҷX Uv1IK-mFTa`%rݵ<@Am0.E``E 7(y Lӌ4T} v:!S ?oEeo|l/ې_)fqFN9ZhJ8 e$Rr:whL!V|,bɨqI$wRXu2RQ;C4(*<.mݻxvE2,m}9  `DUS_K$ c1Y/ >U8GK$-sMѯ5B(]OL.}n'(}N>> \ӆT2?oKP$ |=E6U\u?EݠC\r?L!,h ~޸ru@]\j3g&Pk) Сvvm.! c-!+v{ Jv1;' *r#{//q]@ _QFm޻ tbIpQ'nY1VRY0"UAٛ 5>&s?#O~u*9TNna<,穭Vߤv=_0kȍq]FSi?1 Wk^CR XaB#D 5':v/1smdL,¯?D~FWb*5t໸xp3Y)OSHѮp0ǚ{+ۑ~R.9NԨQ~@T|\tb}f#puݜz4`di J>E:1&TLէf.YKYF͏&Ce,iS8dT# SX4_*e݈h;rQ'b!z.GVL>`|;̈Gi!F֝1/ip)Rk6Տ5үm*z*",jĤR6 4 H=/\ۗD㈝]-ϐ (]'Pw-pUU!U5n-@[:m`j*.>)%zT$h `5eCÅBeNK@j|k3EN !+%E& jQ#*t(][acFL k*`$ L !J_nn~Q螧zNQ=\ۖ_޳%"l5"͸:N9GfڇBvK(`3k"jtZRHd ʙhg/{,|Oy{83 UYr`c&s \Jŵ\N%#b/Zrا !+RͯABDXE@j|.׾P' 1oXd.2bRZ<%mCy|UZ5h;tƤ2_ )`,O{nZSrZ{MU Yo7JRZ@E]@ĸ % Sop1mёn2{G ÑNtvX b q!ޛk}_PW:R&4cTw>EWo2Bjr*CԛNE ka2B>T`ow(S1)BHy0Q]Qzڵxnhлح<;޻FXFuƬ Nu{Ck9lpOOjslh" ś>__-W:|Z2Ay=DԄ=D87jɬ6u)5B%ט)5*70 eGadt7\F[5\{@}Go4!̓0y> YUoR4ow` ɧT!_:7)8 pJ0$Řk6k5kITxupA3׻O` _n2鯿zQ$7G!Gl3Cqq|RAq4w|50kC.Y+}%=e軜3"_ {ⱥ(^:Ȁn AeXimn3Tl{2peu:!d{ƶJƳx$Zfk}"-䰮eJǓXKDAo\7TmQה+*#>pH2f%4 `3%7&ͼ-Z,6p #.\1s)VkRoWd(-vu`#DIT̕cҶ]'aqx)m7344 :Fô+ uC"$~XmUje/n~Dt'cz qtFmqƠsDi\ >2 3B"@i_xF/(7!{+!PՎҡTIr=3+)u ?K'i-N"כDΌR*xQo^^*ŘYaKQ+Z^ثD́W=Tsho0h1{]EJGc”\p ޓ!z\{jEY /16cwնj]*Znl9l/+7ǖ;"z+@!3tk RY7 /(DtX%Gu#fQ1P:ٌqEt!ux-|Zfd~)iUi Y~CۨyId0%K'M?Z].4f!fj'A1v F"m*X=3;6pull`UK}R돼D4xEEh:wUD Tsf+EXWdwJiãy!+ q>M(x t2ѰݘG5#DAi/ǽp;m@Ds :)H@2u8Ig;?Lwٙ-Y\\.~v"6iN?}54bWj R[S[ml,hP2T H Ӗ^۵N<|>#JWXht.6KXa'J"v {ӣQ\p)熡HPťis:_?8$$M\*P{Ip+p0]Bnn(N~``o#GzARsL-clUJb;`6!zF7Xpfd1DdnxzsƼbi w gPR U')$Xq'2<2! Rn;z۲~`fԧ;ؙO!ZSEBTzSVZ-V9b徝d#߹^ͅn$^Q4 ,;VCLfC^@Pl$ש@F&2' e hFCsNzG1l#b[+Pg7X.(ƌ^B`km@en ͘N–i G0%10c <#e?ԡ9&2[GT#MLOP_1L7SR>\ف[ CwU`-Ȅ\8)MJ~a0a=ы4WA7{O,YLzyfK-}{ Ct! "eATW7E:\usuvb0C1 ]þd# &m(IlJg=i$NB-ļPb:smD }>'2ܹeiIQaI sksV#Brs؊(buݿ?ZhD?5iQX&ֵzDU*6yEktϛ%Ac␋u8A 18!:ud>!rQ)*DeSBwISM{4/u7J~Y;qǎиuŝzL v=lJc,NX[dќ6kl)9^^7d@y%G %lcn9z7(y~ѥV};x˛XQDYֶ/ Lb{c:eYӺ0uq"7*1T@>|z¾7n Z'E=9J'ya\K-n#;/'V*PK"ËVx@qՑʌ ˯#+{7Hۧ+cqۖ7gX3\yIkWeuG8p-(Eh=7`L@y4DR^',DCX^6^C0CpmX_֕*r>;>L`Tq4$bliHZ\ek: ׏s%=QC^M*6ŞsۜS$Y:6&bM,jF*QJĠYU=R_4#2Wqgw~EQq)LA~\͘S,S h۱wOd:r"Dܐ^528*_.Aٕr4\n7h!54 ^ lSk]=@j#;p[J; Fr yھLY&F!DQ mSEyh,?łaYo2ϬqQaNص)am0!߽D3Z>[|݅IOxNg{b_ - r7n&tY1 F{n0;B>sC& rnm|Inq\r?Ú+/>!;CW; (ldY0\Vy}QȃGik{> ߽_˞nYn^g02@) ip'2I4ܹѡc_XJbU@Y`~+혝rl_eu;(DŽm(_8 ԇ΋u)3Jِ3u,L ê*C76cP,8d'1"F"Yl89?(2d 1.zUO8_7l8os;F9X!LRNT9V٢?Zk{-d <1q"q`Fwa҇qpO (;vL_k8P@GaS=;W91eqjue@s\wo){sM-uy?@z2,}ݥa3nFР}Gzpr:%Q*L)w@6o)х) /pKaꌌL~|2ecwͻL$m`q(כ'!]Q7Aճ9/-OH2]>8vj?r2=.E&Ϟ+5 JH~Om:^5v VPseVjDl`-wZlҖhS(X^ "nCUɨatLHzHēTaf_k |Cǻ]E7Ah}qbCQo iy'LN&Rg '48E-%FׯPs`jZŕjG7{ HDeIaX|t9fLM9'2yc1g”@iFWp~%m&yђaH'a#Mk!JĦ rB{RbRՋ60komB=Ďɽ]CɀQݥvAY'D܁Y.LMmvmzojCe1 A |'FS2H"~z 7mt | *omZ:R18ujРTMv^a|(>ELl:*C5trFr< i,q>^ñ4 GOq ɔè}iSj&x ho׸1  t>@vTé_xdǏkсN*ԣvq43eEZV']\=Ԧ ˘e= rQ!ߗǑ}Vi2+mwFaaTi>./ú~COvc\[]TE]R;gKSi>؉c@5w@K`n*!E;Ѷ l@ڈuhYMr_tE*st7#5a|o"h@-5VU^`1-,8Ԇcv-a#,m1FX\VyʍR[`fZ\M󊺎? +AƄ˭D  eqarE&r/-/һO#8#z߬#ŝmHMnXh2ՈrUm"4FB4,AǨ%@J.&~.%XA= ]2JDYR B<#6=#͎-:%ȧ~`NQkH<80;NO:EJO;" 4~†* `!ٌh sc: x)΂U|×ԠK\# *.׿W!ӌӇp%QOyNXyMr t0F#N%yRlB`s(ͶhEf>\,n(t^N%Rd7s㊏wJ"P>Ow@t d6zVUy&M2I~4+F}ʪ(O, &yrF29 &{&#,\VQwpP<_A%xϚ>0Ycq :a<!G҈,Of;v92=Iq^-$ܪzAڄ4,#2<~Q[ȪO^]@dn ^|t 4߇Lh0=yVp:w7߷3s1|pN ·0n\|)(}p8<lH??u;|gzjV~~6oz@aL}.ؑ(SCxVýQ^8 !l^00$3z;~ZLl6!%ϡG\z@e#,ZrLǢ, Cg_ZXN1&"qvBNA`MND.dsF|3,|RC-c'u˘RU5Y w$$t`WnH`|lVʓ͵MGKݝ"GDM"(L0i~#CKa&l]@UYdwҴ8w10$U+ d mϷ~lu)1Q>ޤmʴ%eˉX<[1Ga`ZعjjZ :: BꛡVgwwy4O`\H1l!gGr\z7xVߛ |ƽۺUW-kn]Y ίN=`" M7-L[8H'0ha97_ճKѰ98W;3#JԒ2YԲW_u&NECcaTB5Y)i6E'/CK`3Td/P}etC4";r|3p{2v XI(5%#'*v@;XOWK ]5Mv/jWx y|I񮇠Y7-pP&,țYd==xцꚭ RcD0 gr5HHI QUTUMIn?\` _¯C" &3ǃYf$"*^HkWP>& w\ o$ov,=@VVw#^Sϟ92~.0e{ln7;CoHA&O7$<}e J ZY_6Jw%asSzW~UA?cV oT/E" څ&׆v>kV!yRsgx龺cIjoF]ܖ/]nCaxHsV` _7+k e2Ù~:.`|%m G^l`o} +4i3Ӌ*f"b^-]-< T݊Gdar6\}F# Uzhr[į BVt]YZv83R"m7qIw8nS4Yu >%-dFY\x#IMXUO$(i1zֲ$3J?75S;04F& qMQ%STɊ\ vCo^~ ^A{p$Eŧeڡ16nkZ5uZtsnO &qckO" %A[ -D##,Ӯ/L=@w/)l+ yC@@g3V€Mq VkU2VqD9D@/~2.}MH E mX=A;]`%IبéJ8 poSΦ}E*!h:Pڶ2?lװcS 6Ig,Mx9Xbem6~oLJx͍~[')bﴉBJ$ (tj{߳U<|1FdŖrGv*6G.7$OO{hX"$Z3G<'L暮-Ar v_/dXKΡPAHx1 Fvgۧ~:j"ǹ q ]s/';VS2A(M2TI}Md`q1 k:]4jn^?d{Rv3º"QAd!yA_?>.FP)3œh&a |w^ӔUf52>"1"I"uˆmBt~PQoI4us6\k&XGNcmh/ygpk(򉲐ŋt"V\}6x ٶNޕ,g?{ I,ϡZ؃,D靴w2s.D&xHZ1>rmٰ#9q(HSr/ÉC~B7OE@qiI7I'&OI+˞-HBҠhbwˊ 8} 4wtP7iZIv\6ۑܬ]<ٳ~TwFs_TE,̒1~FeEk'J \"H @aẙ**cD b >$2Rϗ˩c,&PdawdJ*l)߬+.{U>z).7. DH e0:7/%+r]R9E% EJ\wleۗB>wcǟ0XzB"'ԣ1n)H^k&^&nmSߞ̣ QpJb)JB[< .sFtk& \ǒ_e;lK~\Vqz-V8Naf#Oyc+AFV@뽱z{y6^XFA8 c_~3'!ɇdm\ƥitg:O0uEh9 g8jxl| ïҞV/7G2&> iԟ[;=i\ZT t#-dЮ*IHIO\MSl<)&W7PW ;-qgk\jX鎍}IZ,R nݴeseIF5gw斓f" ǎ4zL _eNt-bRRU/ #^ngk1Aw[똸Jٽ#Q:6\Ҿ @+?Fad t;R:MѢX-Bp NT@:=qR'''~5>io9rCdLܛך,xD@"ë( hAMS|gVT95*,7ܪI*V T5>0 H0:r:ei~^*37C~JȆ<=Qe6NڍNAа~$ԥ>iRvZқ&T]ٮUlim 4ȤZgչX=~Ð'|Q ~[3:({o+*mg6$G*ٓ.T3(Hf=Ӣ5Glƒ8.3#kuҞM8CQJM '2>ލn o#E"rzCB(_ ᐙO2Px]U{BL \]) tΥ6A/kN'oWwYZ~SF>'y6NV:x'r]|0\c !Ib~Qν\op2iܱiBM|̚R=I6-v ҺN5ՎU4qFqN| /~yOFw/4'>VwË/Nr۶sN0L@,ɷЁ%Ȳ*G`}r's_0&3)M6oj6\3zxwȠh6cxI ; Ԛ |+MgtP^ǿ>"ysuvO9IMF7!((^e$^/aG5gGYǁ䖗z>2*:rDrVt$ 2ǦGv.Md y̻?F!kȃ ݈d֙vPa3)N!*-$$kbMp6eب0DK蛌>c`pAUCܖR.MVi(hCdx)>GCȜb{C$Y+,$aڷj WmM 2uŕ3_4XT2f11UfޟN;L'^oVWQA)B; @^:iwQq1kf@oZV`K28reF7'^ +/QTkVsUNu33kYmvVxc60ܳA5:_>R"6q5m^;"ŗ3CIZKn2$hWW{,OH(fL:@殩_(h晧J(C0zj 9S/{ @싁}lͪp [pPjS6[! /]IU`dJh리lM}vQ.(;w[d66B4MؑVRh},яd~dS=eHuJFZ ]toŷ{H2]J̉$}!XGVl43=Ll)Z`줴:L`p>V gėjS&y|`c"ͶT]&[ D_9S%@Qu`iEn;'F[\TajZ5OSJ]E8E8̈́ݭpǹ7S`oX;tX6KxZ3K\D s;a9XKSBr^+ N'3 "5Zk h|vC3ܝ"uO0Fip7|C@^"_:+lTn5CijCbdڄʄqC枀)UGp+.B$ABt}e|9D$D,e+fȯ^rS$>הȄU`ulֽnIHj,O,-bMe(uC?ņ7E}PgNCEcTݎZu|jE2 ݝGbŊKbؖ".'l̞olͫiȜ4k1d#U÷/8-CzFη]nXR~(p?D[4z1.qmulGcMjf9JWA2Aֆ$4nK;}/O HCp"f sY[(EX>p|+3^SmRī#\ b"nyVfzq݄`#i[q}ܙ u= )(wm[+SǸ4ؚ&iX… |k~QTp=~!~(xnm 7MO)S(ԭTG`)eݩbG6J&8gu"QHHC}85g;,S _[ \䝉\.cF.`ePN{7 UNKG^۬"| <^5WRc40*6z*v);荈Q|L@LCeXuxD)Tȫ#{uCVyo-XzdRgX. Xo)$t3}{U Ŭ**ǵ]b!e9-̯˵}z?W1i"|nc0K}V9`?]TMGآ4v&$pDB;(f&(ρovy}-ܬrNKRwD/CB3]dt^~܀ԬZ7?q]0o&-WWIzީS10h4-2q.OυLv#[j7z];'EFatEX--^bOg, Фg8#-|=(VB*z~{>FR`RYb-C {:2 DF8=ē\LX.̉'MZ48qo *6bt <z";t_, (ȒRX]4g->kMKb+|%>ױ6׹u:*`kŻ?\Dnб [t5~7*j/,kַ%O+?~vUgʁe=/`M,ќ|ԎO t06¬ x˅` ?Nŏ6IÈ82_Z>ZSHbݸE#PQO2?]=pz\R)Y|=-ݷatjZ)hD{UA~v$4a-VMYGwSiigۧ*&n_.@etC`{W)1@0.8"ZZ2?c9j&>UPQ uqWψ43('rW ) #SkK'Bh`R,j{ϷT A|k|Q 5(2l 9lw׏&|] W!y,C= ܮ"eHN,K$PƑšH1 m Yeg\_rHE"q|=rX3YE[d/3 R*mH!D\/*Fp܏$ RitP-dj;"z"i:]4 L*Ҷsb VoZA@HDUh_M0xV ]@q-6FWaL|{H79/l'y+P +ƑZ>`_I8  fq*|y!Oͥ7xuSa6p12y صnhoԈO2lW -)~NM|9ptr=,Bx!T50t#!aCKH]K*܀/@)G0b*ą(#sCkDCcw`Pى:f{ўUǰuL,/h<'pVE kf])% zϊ%̌+YgX:O` }x:Dnels{%8C'FM0?l~?} ul>Cjcc*=Y%}7eN4X3F;&nU7?.@tbV- L11\%SBO $c>#$6J p \F6df˔*?ƃC^[-اn¹5_nj[c3/:yI[V;\5Tnz&ž䷜2/W7ri"fK์9, DM{|3DLeYtcO9kN٨f"e ^gB'Lw6*3 sH: %Ǐ:ܝ`]MDP=+7F?9ǧ %̝)|%d2dH9̼Fʆ4zj?M)_EU":D쵯:\kU7FB0r0-x!6,ESp7vLsi-P,v-L%9j48 Q߿]wg$mkޅRW͒nZAO?! fk6_O,1.~#bHX_Rr(J)jv!)=Q1 E`.%Qpm!pzp hE|܄9rW+lՂgVѮ"ͷ%83V/Iu:;ox P5nm%F')Vd܄܍)7FƝ . }rHj6W ŽX.NoE? s^)BԳb`ć:<pΎvy祄vh} syd nI0bg { ON* wmyr5C#(j`'T;/^W|Vke<Ƽ]W -W5͝Yne8`M |{^8v(> ]$1|/ I)gqٞ} ""c3642|ƭ\찜 zڍZAexTy#F/ƲUF(- g<%tcTB*k!)GRQl3L0s 8NXώtN@ȳ$x:nH%}PF-H\?JħFr4f:K|ƃ+ˤl)oWy=t n޷e 4xYJHIh%Jd\oW7AI׺˰哟*GN;s fԕP-)IDրt퍁~G8l 4U跭͚wuZ1r˯AӬS#O1I-]61jc#Lhw<+;l $m1$G@aȼ⻭1P"aHm3\I}F.*g42pgϑ b։9.Y)H1>㤆`#~a!jrEFS}c;U '픰ك:9D;O)\_n9jJ.;>MzuFRM`l'\:^ ZQ;L `}i6eduK^#Q6DMҰsm}-ymA*ȊF8s=oEsn98J'Y6KI`AsKu:֙Մv++yF:lĪz7nߣA pw?[VhuKe3P>+}rv?" Gp~Pu-J*^A&evG|w [:@γr;O.Dp.z~~`h%̟4zQҥ`:𔗊+>`dF\IX;+ʷxϤ1t$-|ʓRGs&VX\Nt !4Xد]d2o؝`TXNB;DEKE?@X^M5:BXBիඉ/!bF3z04& H7>)Ma~ +ȕZ/̪'* }Bz!JbyBa?4MyD=ZhCC\%F~A1&{j6η,KNSܛ&èos6P;rP@n1SZe/1??&9\x^ߝ3lK>q0iw8|AsQ!$L哫 F ,KEZA5]Xnׅg '{ܓHb?L2Bp]N¬I8짡UUw) ? wը퀛Џ\@aT-f~N2)hNskΞܡ NAgBMrrVEB}=4tۊ .#c`->2npDM6q:vk8"{ F V>s98.Ԭ>+ZOiޓg9ޢ~F$Ѻe"e~,ʎ󛒽(sB1-w =aϋEa#}JH6gھbf8y6x)3ބ OYOP>XHx%w!/?n|]j7bMK 3JE/w?X~O1'PwgVJɆpe J~0~=s^k :Cɺ xOX}cpffJtN!M ȭ bؐ>SYc_ ]6?nYpmN6HM}t8ol~ sO^ "p֪"J^i!gߖ_NO"jm/ jȲD-2 H$`>zߛEM2Otbz-m`ߧ*2t~'Bm\F9kjFJ4CP F)z0cu?)P>`Q~NancIy=*Tm=F"#8q Xsj*ߪ`[/// e|`Iz.0>5dNkөk&we5>HNp3+)Gf$] xųUtBc=׆]`k&!scÉ 4NFdg4{=ARq+8["_ ZPNRg} †j$yYij $ aq4.$+|\_Cr5}>qA񖨮ףxbow1+h6e䥡D{i(`jA1WFxWGSR@-uBQ[VD!q %w]rf'xrK^aX(r &R~§jWҼO }+ y|YؑRNDli)\ze$\oq('ZEiEhhi0ƥb5q*y%Z(ho="!c`%+5.ʕ%jE2N^IsZ{ Q~hcpdxC=\DD>M|C"LuKPDq;ָU< jcW} Ukq_Atd=c:!Vd`xQzRԯO1R3լ GWx_4;32җ>#D#}8 zI3x@YU}am C u(Y85֊rEqz7\ ! '%^[mH55^7с-#NdN`SOQ^2l2HO+բcMwlNL1MՖM3O4u*X3IEk9mytuwb}[zt=s͑947EFʡxEv:}Uw6x!Gɠ%c5/|޼nZh,9@˙P@PCtA:m0ޚszKQ}[Sߑwf: H`aN8,7 omŧd aP"2i.,ԒGtrǜq{tWFLV"͂AY "|) WZ;0No0;jhmWl(apvua^P3E婳ˠP{PC>! RᢽcU~>q53cxwbK >q5zvֈ:lu!! cW5qٽAiZ"a@ghv9`k@S9/ acz}Lji˫ Xw{1%%9Y4? 8vgd9qq@ƒX X&s9G;G=E7s~AnUМ쓄lBpk.g:(Q5! {xX~">v{ZT&ˆ"BxBR?ԒG2D3=]K UH|R)?^NQuQ""6cq/Z"\&J0z6dG0r!.$@9\*:{Cdm]o 5?L`Pй1aB$v[5M3N ۜװ9rL[P ^+ݿ>z&=>_3=7~{n&ץZ!³,;NHn1bp -.G.w<L1V*t\ik3ldxO?.EJY:{'Ab=>],:bwraa3:̈^E@ģt Ȃ%y#_/e7Pnktz| d7!za`r*V'*UNy(IU6:%,AfTԒ@B/M7[ Knڇ|eQتj-ѨDAJ5@S6M 5|]N^ Ts*xIz;+rEY(}$ 9G<*vh%Hcoa PɿR- ܝɧ`s.[Y:p˖XG)Q$ mk _5U]ˏ9"}!:r+,l/]t ـ7f!cFbKqg?JIwrjuYk#~55@fjE,7,e"'D3`"ռ9UxY5K(1"wTB#w- v}^ ú).1f $/;f6霴əjԴ40 H (joۂ a$X*#FU-<CSۑmJЩwL` Łv,EEG@kגvC@TVQon|p #E7<MdoKUjmT鉦`aaH]N#"P$Nb&L~MTu᱄ǫg@Nq)9 >礢aAQ^%4|HΚjE!D;1:aa^IwBC$AF,ç|?/E^ RdY@9|rPLGu'nhh zVE?W +k=Xoc>7g/X1C[ęrUceE~eb$MP v/zws)c`:NxKǮeL0I !VZ/8;W&'~:voݡ_-+zІ9K)NZ%]OkԛJUR'p;Аm:Kmi5:1Tǝc~Dn}%㶠*x,#_.7l_7`}RȞbkVN8VW8ةl;:asw~ :n[7,L x"h٧)ެ̪eTL:{,3 7Q vzi#q-ǻXf+j/934~HV&DAKdgH݂҉w?q0>E*,60(얮4>Db$g oNNX:'D"H)"s-"ZM٦64ɬ>'q'ͪeJ2KkK_sK]Xʗ:&Oah`j32&w'jϵ~ KCxcSٛw}}7/?"Sy7Lg ``%Z) 149)<~b{wA+~}Sl O"Y\$!h_ѡ_u(ʳٿS7!absYia\zN ae#LGg+/pHۋec1r<ɱc"{gWCTm3t|F$ ,q [+Ch%`>܊R;Ҥ%޾s ΅Gu$jt$2pS/Axt[BSR;3M~BQ(߾"mfC72Sߑ(LVR-M/q%-ܶX۫p}!ߘE0!.% u娬Hyi e@5D0Qڎ{A>@h #(M'1%VSOq 1jP0ej6{>7&Nw3]q)#AFʝ@UM1} (mn%h nk*-u$3,ڵ9oSU_!qm-R=RZV@P<qN0zN!'hbO"ch@8 G1KDZ?ԍPU/'PAsbܧ 0ZS8bl;|uJ׃ڌYʝk]}`|:%}*ʙȀ:|?ct|rw̴!"p})W4j5z&ԂXA۝^ *.ǡV"s׆SBHQQ?@Z  yƊOk<)Ń<2]u!qA-d޲[.Lm"qJ|}B={fTݞT-ķ< 8ȽoMgViTby{v_ YؗjuQz gXg=hFio 3sMk Zz;9HO5 _͝f"DC g6Xg5OIך/vNH.Așc>LAi Zۥ")dd[[c+k h Q{t.׊7P(٧r)YX`coAD'voD dW}D&Pb4G)U` DN{_ \F)̺Fi- 8]GG(a5Z&¨ZO3=q^}OZVg3舯Hq'Z!xn-`޵e/fym؄~R2>QGcpc'Ŝ4D}tIoJύF՚? 9%5ўl,1z`%,_~Yp\/p]o;i=@,SzL-O>s$?aՇdnț8SOth29aL*ޗ}xfw7b?z3SbrH0CUYJBaԂKS(39Ƞދ}YKmR\.a-VRbu|GAŷ.b/ͬ]i[9ĎbA4z{\yޜ* Ͼ:]̃|9 >H*"_ :q0lF3?5灠5.=R}9$m{ B xwRsssrjH1.6آVl[/5%qfMAAVy1QݙC[mQa@5י;Y{ē8Xvh(Հ_280i7@^^{ＹTE(zA#N`u@#s(|Gh$<^=#G> hqƑ4AKo:\,`BxdJ =cۅV+2'xqˋ6hgn߈hD-z|1992%8,;w=KީT. n{D^}ޥ<1 omϽ4H :ܸa*ƨl:S2>N4X I(auW4U+n(r>g+5MDb\uPaO*؆lF#_˺SN#Q9yOF/,2}u䍕rKT]kU d7Mmڕ\H&qu$K.!K?hMAlrsKL h"AfB<獪Mb풕 cg2xGk/volrɧ>raur.5˸,v4bXϾzU~O.B^*szawqbq4tDHK#tOWU3"|ZND 86Ld uO_%LޤnDHs#ݫF$Bo ;#XG.Op R:w-/25>}h{Le=اj,P=gϐy?Ne\\BCEC^[Mul 虙k+dDbÚ;F$}:- 1s9Ժ'~` [DoJ]Gg?51+8 8pKth+Otbu2s0& @GN۶#R39(-pGp !=OChC eOG)Hl=N*Cjx&ZNke} 2-# ,+:c~|;rPdJ ~+H4Z ` .tn6 B,NǘbUgT@w'ZGg:  ^"bh`$XBӇA|ec&^ X 蓇oSI낿]+0;עPϭ>4)Ηoa־AH ^OW (7o/f&I#Z[D:OFwEc,ulV,_YiF" *y}Yl;6M99o .)뺺nErvIpXdFT !Nkټ}+0p8MFnҌQD啵LHݒ80M6H!#y2ā&1oʹ8C5YT }.=a`(?gDDdyN#H"kϛB7: M8HgG9x3MPf}ěͮŞkݩ 2i&8X )nstgƇbhY] )\g)j}gu6?:`q\_*Yi{,b8Cϫ~n.j ]pUhV xWǽ&o)29}~Zޏ ah#lFs;&KӠa8h7&G Pםw$23v ]{vZ?(ا-ՒŤcK0BzruzhC[lNA@m ?nU<&EZW[1BXJT%Pܰ~<9 f;o/^_^_0e8PtPWKvG%MkS:QXzR$'Պ%gٜ+0GTzCnLM a=Pk9;BЃ>&?6`1)n=?-|HH43\NFzr>ڗgfj8&ր^3]U寠:r s2ni3Ϧ)]+Ɩ ;z;րsѸiqw0Z(@b,W%\HJ- a퐜 s.P]bn $;d9v8l5#}~7dS&K̵-~ 0$C;_*x[ y$@1_G]cwLf >%WJRZi%Ƕ&㕇hkl|ET!+HG]aoo ɛd h& cfЈj;4A"TUV%B|dIJB!5>SZ{mKR^պW5kfɻeЊرSkxUXpTЇ2'NnQ+6(CŭPzoٓQ )4hS6Cq]笇 {`}k{Q$p,!.<53T-{,C5{ie[fJ."h/iA)zG(zjk\ed/^'DF HHi:nɣƻ@~JR9p#~ sc WBDoCmzerXF.a\x Wup?GUNnsx`={Dl0W HCmBƣ@Ʈ;≠E'qz OWL5xv,if2$$jUpH Xbt<+ӈ0㸐|%뛯6"bcjxDBuѫb9Q\,D(pz͆FezSM;z,{I@F9lGCjy_s>6`N_ho>(`hgHfh)r[fQmKMh2ίmElQRFK d9N̍}_*8ro?$‘΀FdXM50>AZdt](~ 0dk?Չ>Y,>RjWGYFEf;_}GqVOv!HK1d1eG9(֗;[Wr>G3Qo/,㗭P 2Ci =NRt_'s0DT1<.y3h?خMD}Fnn/ qfK3v.Z= `uvEJqr 16'4 &6kv'C G'u1zDIEH}$ڕ*8- vԴiׂ8)lD1r] < C3"2DM/^>4doyJI#B3Fn$K0 <3zNyx )RNA) ]MCU2n[~x -A$`Q+|)S/ YQuetT| @\h ϧ}mA c@Cyfڮ(Y즏cf_&0cag[Ia&ly+E(H /; Fv&X>/J#wiq&PtHƣ?s*ݘ{3dQ "9}r9-R6nW$vZHEFUqp&K^)L[1+oU6y_dU-l"@t!yE:Bwϡ`cmMcW3$+)E0SZ ^Y̎Ӗéq,!.J, Ɂm/e%6#-&OU4DyWT޻# 0cJ#YMɄJ7}uFnV2R$-t>J5gV})}Cl Ig7Ԫ.>+t*ʇm"L\S+5zJtT6Ru$ss/HDezWؼ۸`~O>Y9 I:f2;6.׬O<Ɖϔ \݋bٙ_Xx?#3U2Cif}*G#[Zɀ+€`ZH]?@=͚WrX5* nrIڬ<nӍ.0 i1$#CsbOʡ(nq+.Rzx;eI Bd*҅=CXDHuCv|#4Fwt\,Bu0& ~KDN|!V ͸p0 "#H4hwx*J,wh\̬ѯھo< ~jܑiLsbDa89TbVr!)Ͷs+`Pƥ+=ؒMV2%{XKJ qݪ[ʈRfc le~V3tfEgi'F28`LÙҴcYj6=1~_K1W;7} G.UmNULi6z vq[;zJsL2sL"`K{EX1hv1uj s[jRn+Xv"myR \Q_vHp=|E ҘA/Qŭx[ XC.'dT~u ܱЌJ wnRؼkpH"O}p{*ր/i:|Lh}zB*,Pҋ3ON Dmq2D>r68XtޛVW׻RH>An!17wI횒[fBLT"(B<6Tl\`mꝐf;dzozمT>}-'g$]׿()Qw׀EUBrJ{#x^AAs ٩s=n"Lj>ZG8CfWWC -[j'ޢjDvM fM?Bq*q-thqFJ%gpS2#SA*}ۄ8XA6* ¹>Oɜ([xeLUX7e'S ۪A_̈́0JJ# ꣑ޘ|~/zƤ$Zyn"`);j%h,G4r ߒ7KNdͻ^#7qmgwtl<݆^?V ѵbX~x՛F1XӺʶ}n?̭b>^<& Ag#;nV-$&G&䑎Zm}t*\IjМ뜥. a:[hи5y`cqn1T C:d[}ڞF4w@ԌUFquw0?sDR^dW1L߷OxաIV7.8#0jǦ0t8藻pƣ+E\l&zKaMHTg@~Y,9[/j⢕UȈZh,~u#gب?",$(Bf 顊П8l-Jj2VIg;?@9Ձ؎ɱ{~% gyg4[PpwIyi|/d`sTJ#5QŶzMCPw)' DT)H?SJ um\N%OQV$WVkhjg=]%\V{-)ǁҁp}/哊2x;wC):T1%cDLwϮ(=D 5pt<>jLWώw2@h*Śm8QQO[cnvA*ŘdݶݙJ g u}q ^]h$XF;uظAes 鉟l S,!@^ 厌ZMOF o]bIN:IXRl_h)U R&GjR_oc8m+RA VvTį _(*^ Hm;2r/5QfydVfGtlͨ`Xu79UzX٠=VF;5LK2[݀*{wo%{M2CMi>GiIy$ qTð=WRHi4I8;Tz[Sf,m(zzjb#w ~X+DCoH8f\5 m0q@GCN_Mm4jYօ aPPʳ OMz B^^kXS-#-ٰ3ׁe,Ќ=X>h-Yrj F!ЋpUXݵ" ,[#NpLnkXGՋE9|V:+5҇]z;;0<E}tX`G Vbk) `9MdO,%Q?!3<=A*ʪai*#*_3 8P/Cz8ЂJa΋/xԷy+"t :Sk ,!`rTUlڠ@P!!rA \lzT Sq~pc#I].dŰh.f5)k<؂ʑ:hRy+B-HCbD2JW4l$߁)#[G- @ ,w b&/k7)]B?ԶV]S0Ffk*27n&JFT*u-FVHg"ڮxT`8q16eimdٖ#GH tX\]bΕ[U YEfravV9˛sZzds_[pҽPuST u]f{tDRCeU(p&Ε}[&" 6E|EyjK%ztbncY} ݃k\Dc|1b[H5I0XAz.&(2̶-oQ_k`4^pٚ%#u{5Ђ՜m*h>T*fr+.i;EOmB#4dZ*C-*t9 AYX^lW/ g〺' #/4^FTb]f#Jc{焀 @Mc@i]2FŹ:rВ(B#x𢋊,?+p*F$:?XOnpt!sXBxP 7f90~ vEckNd;fM>"|i}9׌]g&\L%~t. I:+X+8b0[fW[-Zˡ+ bMz<@bX)euTOv&e6Ӻ,6W<( ChJ9[ӑ(8wۭR;_\j ayn3.sHbF!*߀UdycH'wX:U[ڧ}?aظsRMy@[&9gO o$O![Kôm6Dp9?GE)JPHȠȦiU R28(2s_s VC?z!A*"J\ vY@ӊq1oQAe#* rrX:fԴ =Hcb*#h>*N qԉwwjIkCp> A ~Z.b?dP}MV1&83 8yw_w-]HݍN_@nZVҩ*?팺r'^42D R!̲dfV:v+Y1_AfSpVN@iDP[vo[Fʹ~zi$ D" |3o1=V#Z5 k)~ϊyduV=١_恍b#hq˱G|P߹lÎ;ӗrr ht}$; c j:5Etb5ُuP{FkdM]0g1[U >h= ЮJ!:,&RZ=⤅$oqe%Lj=Cء]P"13x2TufV$` X-*UWwDf='M6ɏMdo?G@)@Ap/Wy|F׆di*:b-- L+z?F hc[&u%hK}$V}GHZ5rW]F>і;x˙f$\J2$If|VJlבsq˶_|Q: p Ƥy_׬%aI ,zMRh2,0%qe-& LO%I-bꄌ.!}Eg5L3q7Km $hJHBVF˼:d.r|\ T <=Fc+TjyyF"3=+?c>]P|K{Q,/x~ο~y5]p5`txbAS=M){c ߫#d`~-~U 5"_8 VDyV|L̿{IK)U.q7gtDzjAPqCZ=)XT!Ӟ~7oS:n#k&zȴ aJh!^~E^Q?2)d̸c!r\Y:a%& Kq;/A0eS/# Pj,_ b}&fdZyS5Bm9",&7eAѦP|j='|KsP=T4sMV#S3} _xi(xZQO<Vv8Qf;F CK>#o®~+$HOR|g]6GkJTiY$& QHZ<?ؗް0_ߠ1dYyGM4u(%/ԅkN' fY0x"K _04pZ>-!-MBNiV!l0R%0fjf 'p~)11,L{k 9 E*ےjk*0P!$ ;cQQ|6]EM>~A sQVլ9W(_ڒ`z7*y~v;qOeNU!k Z ht"ôJNMi# .@3FUc`PV!ݦ@&_/Q<lkf{y\F cANus ^ZDۻ9NV^anuc58JtBܗO5o/o!Uϔ'JWgC,%kܜ%J@ݏHB-\|&)Ŋ\nڸP2O@oA@-a4ifޔAgz~2ʕY[JTδa(R: 2c{I%0LWw1%ktlOEf.'EWѮB8mbۄpصB;Opy> lrv%!m %A1Ig=X_Gg08jA\?kSipEa)n΍Ӱ%۷RyQ)be7B&R\X 璸T渻OVg( -q1 Qp0S6GfLI)o! 7+1.q_UvƢY[nJ_5YK ({ޢylqkS5C26Dm$`rz.l6PLamd%Ȗ$6-vܸ,FyZ7Ժ&&fFKv=^;jΏQ4Vl ;yQ͗ܥT3=ȴvm<;L(TCX%H5^fHzHY5y$ E0y(y# w)s' 'X Sms6]tIv)Z KM.ӲLBA&62O\'6ۊINT4?ۑ pO圯?rg_]uVHW`^:2ʟІi?J:|GAY8j˘w# 50X'"Cҟ߂5!YQuũte^+tq\/WҀAP&4 V(Z4`xLG_dzDeThFR_7OR8(Xu 1tK1W%E c`@KnhRH*{VԳi.b VEʩZ%BEKsOD%iOD񹟳I_Th7KHz|,Sd|XEPe4/1~3I(Bկ-!*(sgl?g;aJ%jHn.KL׋1/J71_3Z,$;d?ڻVYM+5(OCShH`/_% ڋl%a#/C ;*}Eyk7+=XN"w1&%BEzf\_TnɵDC$qLpz D oja5qo[ g6_' 6-pWrIJ۵cH:UL)ul<0M#0tl2i"8U%X_³-F0Dk}NNb~Xq@~8)zM(Q}[DgAD8L\y 4w3'b /Ef/V1xƓ1rATE`jk*V/vegA{iM,0H27]ojw~k]ոY8{\lI ~dcoVN~/qȤCb3f\ґOvc`-$j5M]΁˳NJ͐<v&y>j#[IlMNOsgKU$^%DzW1̄:DhGg_wU$@Sre4a/:k4@F3}R[öyj]{0ēqy\ګcpNhY:p#\Io,O^\v˚p5S/tڻ'脳wRɑ`}cpB攬o[J$o[|t3ɮ/wۂ~C×n'bU.ul{0LgRvY{"H{7}ꗑ7uk!:S-%3sp'|t6=~6C i\0%>v%>< o r=0M!?dJPOu"3zu9[Õ*."G4[/2 W=+"6 V.'+0v%LآEP)7/Ѯj@@'J,4":j"1Lfݱ]S%Z-^eFŔ̝vj%BPDsּ UfC̋ /MQC0V - c64XOà;VM샮/?uO<,WdWQaUvr4~ξB%Iƥ7qV E`QG52[Hى+ Ga^Fe|rmeJӝ=էuB"G ̉ @'uWO֯sxh(UΎB{OcSef8y%@$Vv'{wADT,)45 f1ӭMyŞȫRc-F=EϒkÈ+Uf*C "'3MqvMa#w 4/Yyǚˋ+Ùr:nݤ_f o$`ߨ@QZ;V [,ޔsK q}ʼnͥ~ޒiTH[4ytYd~ KMՇ%Y|І dQ?|+Ȏll6-E =*н)Qc;8VhJYŦ(nFDŝe(7< tG*Iur‘2PO_MeB\IMlCoCFlƮ ^C/K{p M窱}G4Г\} ]\m ب{ "eӗ^;JiןM x.VB,w?b0D[jc,^ikD%CKGh 7Bs؍ŦL+2o#ŏ`RCޟ^J'pv}J{]X|F|TH=-pYᖃ{̎E1w>T3AoR ݯ%sn9< Da ʹ_j!3eKM7ٽ`t+m_$٘뾾)o{2Hjh2ȁ,.ߛvtgъ&f3)rI.! }KI%)aN/I.[+?%bqmk鰭(spտ$ߤR=:'c5.i0\/-bN.~ s*11138X…*YV| _oj3s#QRa)q/dψƝ WhVv7' y _V uch=˃.F *%͑XX 1d,siTmZXH1O;\G%HlD}n5WƠ*zѣ?0%\?Ja/]4+mz4滘QC+7bB(H| )Oun%N}0T̹s~Lc lGHE[H9Ԑ"܇0.*j¼O6~XoӖCJMF#%l6G m /a@Ǡ|7Tp7 dxfiKUvhnOi 6i2 Ɏ[DJoͣ[&X ,Pg?In 3G@5%ڜЧk$Dҹ n1[L7.%_]0eח3kzXyZv)v:S(Z+Nl|hպ( szqfgg,&i僄ʾ(.7}TBw*C[_f_u44-hێv ^[r3;3rBB(YmyըPKzQ]1ɯ{^eKz<ɑȄ?"9I9N~CP\E1ho@;FEQ+szijQGV*i-G(#6KQ6xd=#v)&ҿMIEHq=] Ģ]o~e 8$`В/vc wxO1xrpu7Ӛ퇑;KZ2.&. w'7)8FnY؇N_nLp(u-%'yX/' mKɅ;$fVpKfp}=0_ʟ'h sl+>Ǟpm~@zvb6~[h[vdAQPEIkۃ+n³x*nWeRתͯYm1L /X܈"&v4+7& ~B,ô Ŋh>4{v§['0[H5>gƅnZN_=-͎JLϻP=ϵY)" 6"F$K%9B_a85RN>I \`dK*ªW"%Żrj>/ n  e[y@)5H{XgRTY#KXGaQIVRu&N-aZ'`IAz }c-7'WLUHEy=&B=y%zUԥ:"XF1IX|DKZ2~eLPԁ*mKpUY<$\jYQZ^d=*GB?A* waxBb+sH `Hj-29#; \e+mad4pf\@x)78{h)!Zc_< kf%$$CSOM/ ;0`T?XT-ɟy~e{t n}K/=r *ֲF~9H(יE|Z+pT)I:'~f,?+jrZ&2fbv^^uKPD@}G)UH:>9p"od_E޿:oLs)yd`Ҿ}Eޘ|!;' F$߳q]TT{[Gw<ԢIBv+G#|,7$ 'cGr4Q*`x+w`$NtQ9&lϭa^2 2܆5!Kփ>S&9E!ގگc=fSfV 3ܴf3)Dy7cC4FXV. E_R:L̀lܽc 72;d,Q jJY~ {t?Z_UǷwȻRÜcv7#4M Y=HEf@%@n QR;F0M~Qw61Cg'2qhJ{߲"Ȫ‚Y;&g\ow0{} taQrxonI&pU*D9K"^-1psn.?2A8".nXN?i,uBW)S%pm.!5c.8T1=Oaazqk畃@7#u\y`Ыs;.]ku7w6s|u8&'Pq^؄.$S Ýؖd6m6Cƴ= .T^dma) j{/jߝ"h!딈})u1p쥑9R^>b?_Qax Dw"+]*04iu㶝En\Dnŵ˜l Ϫ˫ 1bf5,A[!RL\ u\ثxl5HJT—96v69OyNOQ/ G&Q'ܘ* I,4/j7x|^0v 2$YT/Jz2TslS@6 ~JfKyy',XCvwpWxWeZ G8Fn:8G?ڕ N,?WݏVمHxfS,^ `p(د1`(7_̝Oʝtӹ%(uPh"X0:u>Yqޑ(R'8kw =iJ%DUS~'Bl$Mk=:QHi!;+ .;vXRm֋OR5r:4ڡۊ!kRL)*:g!@un&!߆u+á[G_0XfQw;wn4Pj.,ƫ!Fһ!w+f3ˬ8Um➜HZJKnBVi;C )]A  h*ֵSo\oK;B~ pV9ȕvH*?¯U5Iqd8ȑU/tFp Xn8}xLC:36\%S'u(=\eCh0\>Z=\wM$ z&wЛ*$JZxpʪ#o_>Q-h<)sA܈P]pfao'dYvB?U!tUeOǦDp}u7Ugx2cqYq}+bfV~g)k͗<3zZɻ4̼(2.q.En ̔0:K(P3qNߨ{>yp`K Sc4!g&͚[bS-A,O6h/q&0m`Tqf_bMYH&.S[0d>^P/[ 1ELѹ |YNِkm!X`MontΖB.D6ʦ)S?~tqFZM NGUд}3op.ep4qk΢q|~Ώt0X}HL1zM֮ۤ뉁 f)(/H!pMU7Ъ`D0SY_,r3//sՐ[бr*$ƁUED! z)Xe9l7>';:' o-qٮ4n}zMr{i'#~eiZ9ChhOoDBė=IND<ȋ-1+"o=ᘫ 9AbzcDh10,6Jک84( !vk ŒB|[@|</g)jO2n6= HAh3]N^ ԏ-VV?7,uߏn9wtI 3g.8j=ó;1EwxgߒL^ &9Q<Z&0CzX~;e%xFv]@~$֫g%6^Ņ8[L,% [A5gm-Dj޺Ex'g2L{@d773Q?N0jy'ߴ׈n9ͼ>Z:Gzha>I}\Z) :W 0kR_V`XR` Қy)Ɓ-" (l;k VoWQ Ki# (Ӆs {u X[B8is$7oq^QGpmȢ]ƙ=r%R)!h(fWgbowKn;s}̇ݐ l tvMҁVRKJuб1Ҫ$H]İqz[Eg ҥRm KK.iRUTqؽ?x?0Yv=li _Fl3Eu$c:t&M*pob< #|wɫCb1p 6 )}K~~ 3Q.N_IƘeP-jgHcJn><3tryL-ιJiLUzQ l3C1f]& Xo-%S &QלCx[*v.fLE/``f9S^Vb|4jWU0iT_p Ԁ^XDq[^Dz _7=5݈C ˜n>/I.hB)퀚f>tKP{o,/zwd<*ֿ2a^>b"[UU.N F0 eG Lf{ZTぬj>+r@Cy=ORP/0nHV4+ c2Ri'1nb!&Zc͌o= ARdia^d3odTDĀoۉFYq2 \/tw*-荙zqȠ2U=#{\q}i|YsQ ipzxVܞ9//[q5Gl:@99 oW 6ݞl@qTP?MlK-ӞdNu&CSR4trɪIHIeU`rmt\tRʡ R#2okv?|YˏwOP|lE2$'b6f*{|N~ ̮2V =3n{+ boԅvx~ HWv|PVќCG npA=ё7lAcNsǗٷmvd죏}F]D5g)e_?_iĢ>@x yXn?_ܸ#~QH4$i=-bjoA2ӅHV JQi8XО O0@ [ r*mI\#br5l[>UZ<% *n*^ց!)+²(Z3_d 25T0LݵvN(٦_8SL+ݰ3S.ooy^}.bz!˧0> 9 VNoM]ٽ_GwȾgqyM>5)ƔX"GԚA݆ZjTI7WMmaloOM!.YWluV[+e^}Ǝ=N:nrX~NaƖ{Ï%ь vV4 !H/z7Qq ml sTvQN衃P޸$Bu<7,Jp-G7 wn'niHKFO rrȾPgb~GXӀZ}>w̗ؽ9w.ij>~0W B3RVv(eTv,^"ȷah iKInj.V*kS3FA }}%/UK˝:{;lP{01j: ۻh 2!j+u|\&)9[,aI1lf#pVuNJ& \!&J{[p4xh;("=Rj vc^权=8'NYT3s~TPVtHj^iOl3UM< -%v5w:{Ke Jda[ءn\_޿_Jn 襃˒_s= p[gA|(U~޿81xc_ZbR#i,Aԙګì s892k}4WzWGÕv<+QO"&i_ӆ|B=pGcAw-˩ !5^pl>X sE 9o,2e&/T_^7gYѤ6KWI/4#7ʑd!$^KzJzgcP6j?%po-M)=.~-MmV{zЬ'.t{=3|&`PUhGy :`f@oOsZz:gYf &@J7N^}|XȈ(=]X"\'p}.XR$܈e?;-hDP*g#Т! o44PzDUu &Qmwh+f(B~C$q'E49X>532-L20nAz=ԙRG_SbC XAЖS9gδ)[cS$O2-V|L&?%gnU6;83t V>sŢc}2erb=fKOdE =ɏb~dj.`oFWI{ɋb,I3*v0eLT*?̆ī-472V&FDoS>Ò2tMu³HkZYe; 44iHx6M ael4Y2xLn[_@T$I&"JH) ۡ%063$̀972Px.Q'>ny\)7 &~r;Gm+`^k"qnw\kBwRVb}m' ]$J韓2 7]^I'S@"籞q6C]%+M5`)ha_~%jv5<,l0rTzD֔oQPxeCW8~hp(f#KeezO_of^?uݯ (SdduLy_B;4̳!71v>Y3l\waNqGPdI&SϬ)fKBrM Vl4B(}oAÅD#ސ4dH z(\"%bFDoJ?NL"%;Z5_1(.2 ̈́k1uU<؛i?N{yƒ~%SvCݎ+%xEIG!'QuZg]ٟh/bf*r10 Mg9' 3E5uf2=U,~#$c Sڟ5}?)7e1Oa9hidئSEFw5h䫴{]tcͼ|QH\BaDnD}?X\6_-.˄gI߀f^PEКɇV{={>h&|Y_qQ}@0X3D|TsYC=$_T>d4.Gyg5,)瓄yVtRq.4!R\#ƻ6u6Gb)i N9P}mqDqWy9ԫP.#\\ksRr=W=[ѬN Р_Tp5`Pp]Kt^ET/~UeuЁTAFI+n[EJKW}`bKMɝmIݩ"g}; o&-^#N͊^hLF~jqxUL!>]9}2SO NDžO1:0f:QI*"W|ᔥ[|I[Esp32 ھp f~30^RT$dFrECNO} J2 tyBtb>T^]--s MiDJQ~{軽<=.!%3][\MuaJyD2KA%)g 7?B*Ὁ4)m0:EZ.z r8Ug#גjuW2`-Vj*WWQ7nf8€G-ډv1C< `-~|C\F/Ј? n8~nz_َ8MKaQ5&nA H @1CtkAN."2Ht8R" >"_yQ7la-8يKw(HPBDiݽD!{ӉX\ m],8z%sRF!<#V R{+>wXE7:'\OtBGKl E4ߐz@QLi<Kpʻ i;,ĮYՋ=u0M;<R6 @a(bp)ɯ,4LdD҈Ж\\?KZ[!"B>7y)~^jO"2SY@ɞ; 2T'h5~حT!ݿ+O{) ߒz ^"خPKA;ti eo|&6c<'jK!+ۂ^,kG r4dY2MՈ+f߬#?/2G Z^7Y%9:_o}U>t+ډڽwt k4e|w{{i/g"р )/Gsl }1+XJ}*#+p>F6 KtJ :QӧW<vE+  ?|aC+~8.%q;/6XF2U@܉"rl@ـ;Am{ߺ}3[\aז$3h`1 {89tC\10 lHeS"S覐`mn>f`j`!M@.~C0k aA\°ўUf 55cd5)\s gM,.Ѽ%gۛޕo@Iʧ$ d)0MItJ$\Y9m<e' ՜;I3jQ~R\̀D+E%j=; 2}?͢$=G{ܤ86*?RZᮡf^\ yPS>u44q",S{dKAiZ(Zwm FZɆEIՠJ3ߒRGv{O/L564(ᵭAKn}P$Sw+h aoJd",+$%^s 7$~R_ W)SMOa\Z'ٱ8R$wD$;5:϶ Zxi6TJS;eEܡ) 6.t?lix*bKǸvO322U`ړȡ:l^Mo&~S:n;fJ/hIcztֽn}LsS]R>w.|^(R4 s}@*^ie[ރCC((%ys}n ΚՖQ쳿X2ީ.7E.1?EcW.ў\zEʥiTCf9f:N T-_e,[Д"^kP\ϓ>k|Jd:-Nlhd0>Jr?S~?+N2,hZ&TLњקIj23Kf3*^aíӆV:Gjd9nｄNPT //Ti$iiթclh#ͬ?㊗Pc:dJqԋل|* Sw٤CfWG؃7+?sG_c#Ii_{rWpV۫5Y,mcD ӟҕB`͓qo Ȃ8Iޝ1(0y-G}WybZhM bx~47b #)P\%͈hfnI zͅr'?nͩg˻Q3TzY4,P$gKaO(Yee"ey#!b}Zf %k5mh(voӚ9 Onz s(v:;em.:  6?FjM@(Bace.Ivχ<2cFr:wrm1%s%`yv :Egpi-NNབྷ|~gpΪUc F^38I1W ߌ8Hu*57U\Bx> O&z;ț\lq ]L4Uѻc-~1m/J9.]KM ʁu'ogio#~Y`9|%CKG]$)2qƕgM.^"EG$i}#:fA%(S~:F]`m{\?@(7M Sz = fMDdT1\V!<Ϭ.kO ?h;j-]V%B8~pJgs ק/%1pْ NgjO4 &L9>'q)_[Q=*4XlaY Cbg8^odq0Jڒlpuz9Nm v0 ^~6ly'c&)8UY14j.=XQU`=Q/1ueiY^⿓}_eGƏPmLUDW3FHRJ4$TNRQPi<3fr*ZW R_MR}^; #x 8 ! UqRhh>.}F)rm/Z}-,/UCUnؕkb>yL/ӔP T$7Q Zy}f&&Ug8WIL +bܿ˸E} 'zJy<ljMԱ;U_Y3 " ሎ $h݃&C߻%QQQ N >/zZ\c@׉i.+&{͔VдaމO僾,L¸yu%o{ .jXXOR>{Ff"#;)\i9YwjYg(]IG$qD̚䋸" 3QNTh(E\/bU󩜹(RJSh{S6ܨe]RHYωGR-k/XgۮgSe4JAxZU,;6 w7N[[-HQAҧR(('R{QɻgoEnEY-kk eQo~'e)8 Y䶌)t?~\5 ~?NF@ޱM w*UbLF9׿Ȥ]^ 6A1:\?݄םbm,n?c<^[`GD,2D1'LG6Jn|'KMD.[kM-P9 o6qB@,.T}. 6MVZ8d93[xeXӎ*RX<nyD TT~_|Ìʓ =h~Df {(_F\Tv'zډՓGA aON¶ JTB|X@s $7h5// ta6LwN DB:C%i%TɁܣWu^ ze +?%fOqmmѳEbӃ+Z m- C_b;r0.:] { sRpxXXHP[stod 9FWR wco@nFv.xcb[FHmJ'0'sF(Cbrq d"OAUܦ. LZ<' hWf&݆`S%?$G&[%{oM<'Em9̐p^='"|`_Yz zDžqn{πU{WBGV~S*ߕ'@! c74N]0,үQ>W6ۧɫ y,OP#Xʰ.>0|;ZNꥍ?}3q3's/Xi}/Jm9늷3r2zm.9cM,WǢ}cO$VƊ|/tv=4lNKAz'eS8%n-u Fef{ZO-4Êv #=rV`!b3N߻5Nbo0^nYp߮rΥÊy3ѾC( iR0!!d=PvǔvV4`~3^oJ7v wn|b-.jj}.¸k+Ұ}T|fig&'2IiʮQ|d@1By?e25o-sMqER#iHoXjd.tp5>K:R67 ۤEh Pk)W"(PQ*i}4Xg3U ɧBA|qݨqSDZ1=eI[Eӽل 4+N5cϥxdv,rY Ch8u$*{@d'Hʕ/l8PO'bKmy8sK}!>6B5PA.9!Vw;j[WObCl2/%!|jB|9>..E>PW8eZdK_Xo3YMSYz^(cikA;R$! z_(l~> CMצK{ S փ_hKo[ΰhRؘuIyQjvrFVjiC]W@<Osv2j80crloUUgb( ZXߟ*x9:'/f4f$ T,6NFYcs=W}sٓI=5kY}+DFq +zTcP]@ kiŕ?AhBEjRA^[D~V$!)|)TeG8B0ano/4}c^fdyP+Ro^Dpt$Y2@ak40b86j|揑ahI H >t=i+" הİ% ?1UQ.T`V*(Ψlws3411)hI(MQA |GȞaz\KEY*ZV5_(@װ:>4R%eRw^tl/ ]9ޛU{jsH灉ȁ0]=qBV'CщɊ+ڔ9Sk$qOB'+Y+5(G4Q{.4-V`"bK߫}"xc+nĿ8;-w1hבBI͜c=1$-nvs $x{n=0 (@z|~Uȕ!6`gMS!(7 #qY."g#> Jv4:JdԧAR$_!g`4ao̗ȹxE9.>aXgcv.b$[?u5Tr`ȖG09Y'UxIt`#7qgOM] kp)˜G䔱|JmE ZF2UjD!QFE &}$ܘgm-fx~>~E-4!(Io_pV:kYs=|[dU4FY򦣏%<_ #kETfhL}{&鮏݉sz 9a%L܌KSݬ5pM$ 68u?aJE7fKZt.US{? p$}#d(,2YyVȗUYHVqhZ)=֒ZO!z"}[ [S.VrRnJ RT{s/.=S@s(|Y 4:{x9k!=sJ"WvsYH hW$Kh$b,0(IAXưǓV ǜ;XRKUP@odr]ܱ[|7|7i d%%Mk _2j[oSC)P~)5jn;j&Ep}4niC#zM +TSZ4 œ!W'1rpJb!~?UQNX$-Q𔲾V# ˰yk ~X@IU6AhmV$O * SWWN;!3uGAZ;Ђ Gd񑡼Н\f0!0Y.|3.Dx7(_]bXe9;U]I{u.:(x\d-#Y T̼gqZE6Ӝ*Od(:1ejf&8Ai| 2>WyT .19 T+wǙ}ooF25]B{vh.(j'lq]@B,62U}Jr\B^^F?0 tB!nX @SU»;=E2-)\B}.oCoK5KĮQ}Wjp@[miIV/H7G /5~i]WdfvKl>զm@f=?jT9Sy4fm(KE,p-NRtW_[le~d(Kit[DrK5 3X+RdP]D'ٺ_^ӏFTwoΧIJ c10&߭\N`m Yؓ}#-GHWG.q`1rCXrS:*{\Ci%C -s_ئ}xJP+*u檮ShG5gez~FxOpPGMϚ |#uسIi\Ҕӻgx *8JASE&/9E &,WELR(4P;nNƸ4$pUΕ>~!nZEW/3#|Dc#@mjΕB:%Jc"0Nh&KMq n 3ojoީHay@G1 .o k(lezq4c sjRn4w0[rlDO/>)Y3tֵ$|8F!͸f5iڪ YQk-/*-Ŗ=0~yt4E {TK@qA[=Vv:&ND%&ꑈ.,OI<4 F'd E:o֮%SeFdd@HXTx=XMh@PD4vC q ]aj&( H= Stˤo0!'FuIPT^G‰>"$*<'z3q3N?j83x]\)1kNH0~wo3=.$BjgOt8NGgOnPVƻV(="v3XlZ69l\ ?n?}yN7sGQ@).}V'"x&E`98xx*OW,:~(q75x,W1lڢl w\vc;6$oCvuP$`7S&&VeJX| o^_yn:i,XJk"@ X1%@Oe4 OA)C#aPd~Dw;U+JRPY7ަ= veA(mOhJgx*zZ26,dhZ )Z</pFgZ*2& obľ_qVsw}{>(k%]=(+# g0C@vq:֯J'`V Ӻ. k* 43.iJjūԸ,ShDʚJ kI9y=(sECuDP5oyl4t?1[gvZ>Dj@JmLpNnG9afb}YĔ(;8_[:5GUcZ8ѨM\'Pz[l ŌOćcz/q.UϯM u@K=_MLH@_oQDX9]U1JE5rh\&ЃH܊-Nf}kxqFհЇ9ģ~ ǼD#kWA9C/bj u>%khy1s0]EZ gm8I<n/_{;͋=&\Wo =6;Yr|/GdPae.LV_zi|F  ^QeԪɂck&)ꅆʧPMLb 7]FH췫=#pqYXSX69?ɒ/>:)O9ץO'Wu٦z~mn<^4{LעOu `FX)EdydF.C}BڡR>f!==&$('ㅾK5=e=1a_#e>hlm]^>f*7,V,');w;pOq*= 5#X2w2 i%:]U @&Q.MyH)`kġW)L[?"MayCtWFh\*5 S^JD}NRygz #lqtV;{Z[+p|@ShL0yx>~_YXҭwLQMl߳߅y,.4(oW4R!N5Y(=eCH:@nT"8VOk u|DZ]jeY8{P'!nztā)z]E\ c`>iܪ J\V|aW ֨DᛩH.DZX5shq}cE5nelSvbjqQ1 4!g=ؐ<0^}biG5sPzR֘U=*5K{햼ݔ~hAAdbՋmкoB]d{_E2g`=`Cm; ƯkQfz<5EStkv:CLd;n݃ Roe;1+y2_|DJ,{:Nx"uj5&48GAXU=}-x:iewMsKl=)jqǐ=d~Ҟnt d}zoo4IcƧl%gI#=ɑ-SqUdlRtNMQufF+)]0\^0h -hU^ h1KhAwvu?B(U1w,-\wVM-2l'Z!Q)3`Ok+!2PVVfw({|.ACCŃ0VܺM39ɭaFUi%{Ȋ`&lKs 8gw#@R@{ǡ5ci60zD90}F*9w ?VG$0r ZqOҿUx7B`'KvK.ɑ*Z{ >E*]lcWv#/@Klk8P9oAqSp3^GdNES4s-(a@1AW6UMQZn<@3dWSKH ==}|Lwx@+NZ7ɥy?KT.hl<8}r;Sȥn r}˞vΪ?_Sͭj j1n˻;Uh-NqڠMԠchezR9|o}PsB+Y}魊\ 1(75Ka 4l;"ie#ʽVxFD9t./Y8 }#' g  DaWK afZdszyS6)İ-eZ f?_ow-\ƠV`=qmL+!6~E9pv/hOX0sKۇXх i%/$,lt=|iHS2TD>+&K.sye4wbSHw: '69@E-1k'ڔr۫ZoktghVpu06W0ոo؄!&*E Ph𪍢ߤo\po}R1{oxe5Ɉ6nj46I]B 8_C! {:7WwzB|4dAdR 2`4L^RLR?N;-lIvM{S Ab^EF>7oUv%Xf͏mtGqzk4/f qt=7- m"*2rV ELL8!]& %ΏQFR~w~ i=a QCp;X*?V\Ў'yU*AU<*0TTPpn2$Ie-W19nݹt>5܈ȵTK pw"qǭZӇt';'aHȏ7$( j6? ܷ7)4.k6agc`Lգp˦V9=@__꩸toӏW>Ͳ'NѪ6\h uYʹ~zc:FS֕(О:J!H1wɅJz(m"_HdQ-uNB,DAr?vjY(1[lf7~AgxT՝PfH! 4VߔiXM -nX>="ힹv  d/3"+fq6ay:,)3Tʜ]̓sX}[-ͧK܈[3A~&Z^vUm-DONtLؽ #{Q{yd#3m%'CYq\ӂ[b\1ՒNAP8}Ǘtl_$@G[B.~?*6\n prY0NJp5hAԯA/n+_kڢ -w#NpI?F]CǝKJ0th ɞjK&nZ'ʸ&z ZuӆO:c-D`4ָz$.nyvME $E^,DJ炢ũ!,E]gu~چ'| <ĺF\6ER6vtfl(42`s;Mj(>Id`DvTo2{;Upal%& vC_jw S 0ygC{ Svl[48[=ݻ=i3~& - -I M^Q_L TpAjq\cLfӢ%*:j,-G,,3ab~ٝ1TM6t+z>Cl<5[P=GZ5S#Hhq.ɱS;jЕцiLP'g[VטŜI <4P8K=mq+ӾjP4<~3 *wo*e"=^|z\m<ŷGg8-ތkh@Q3M:XoTJv~40VH?מU,FwcL]h"{(Գ=NOpw!%9sh\fBwΗ.(g0[C>ۧyw4Fs3[qO4>WԬ*Yga'M68|iJ|;PdD;rtQ-QaZj.1DŽUb{ 1& ׼##-/qcgp3އW)=!g%;\s~͹)3_X z⛦I ٚݗ#~iaF!7(<7/d69 Dx.hd"wgatr!8#HEqUtAytg#F% vF/oLC5*u\ G= C,%)a{0/.xc<Ž~òMHD^?mdpȢRU$D8]wU|e:Bn1ia2w1Eb$ `K+:zKr!q¹Z%G_  PތBLq(Vʸ{PhET F1&G(NM6M  -l~1Gs\(ﱵ]Dq^\ gQR!Ts̺ P#($Թߡ1Tb o$i\(r{eW}b9 ]zy#9І\FA؀ {l3YK(ѫr0;v3rvj6Ӌ$#8RHvU[pzq[j0,Z:u(Wt5F l? w7%)wp.f5q8EGU$P&݃@Ue#s`dHM+T8c)N|9Q$p[ !䥞*Q.b ?DYA"MfI%HhQ]J"~hE*K͗2sh!O ^)b@ʫ.MqYAϪK^ rJxz[`n =D$pK SU@Bhi=hEp%$f0CIPf8iJx֓`q17dZ 0hKG+(B1"ڤ@rxT'rm<;nw=Fp.asT#wpSj|({CؖCe !BPm̍0KӺvIJu& Uwg7=\rm9 uGux@a҇)Z `/b0QTy|G(RۜYzRLZVg9.- e8Gjn=N"}{YZz[͠Хx 0&( 4 [޹o˺AEҊ?2OK7//h[hFy{"_ʖ;:z;ktVk]c~ aZ/ݫlKɅ4g">*NpX?'+OBm1Ye)DTgop2Cԝ8߽+@!gZT4A5tb RU5蔋IێgfxAG(giDgF՚,vo$}6 (3fZŗakF-;gQ2t`U:~a%{z+/Tiڢ}mBZІ|潿찦mRJ'mIFa/2*{>g(d3Zr 0D҄ v, Y[@݅v|h'sB2 4M54\`UT~0qX 9FDFTQ Tg)DJV@IC00c= 'C\BX琬7חV_ E\_5LzdgoXhoRuy@lܾbڦvkUՔf@YBnbb ؔc] hG}S:X :ߣHka'w쇉#g甂`61yCKX5,2Kdn Y 1A\Ж%Aکծx ljFnBN)r Ľ|ˉ"xY$[;N/v݌ @V\B!9Գhֻ};䞬9 ?:%͹jR_n9}["9W~sRO~\s<;8lm` ބ H !U)aQ#X;ƙv1q߹RNxj^ÉExK&0.uV|zaHBT8~:X9pؚ~ľîX++o]H:)lGAExH|u*g&BC58jj&FghVLUQ2.! lB<+Mh@^Z6*]ԴY6w7hοn݂%/w/M _\a; veRҘ{|#>k_$Pٚ`TbBa'` _a'a$hpjZv[]qPSDK%0)WaWl!}n:5&&Te# OT)P*[yzj%gli}Hnl(9{`w:D\ \AÃq2ӫ)8aU `*缤Fx1$|7Ic:?!EtZzK=s{Fpg X鰎m$cbmiVAih<S0xJl䏚Msoy dsvMUN3kxl!eIqPO"y -y6N3ihK_laLQSn;Q^#N.v*)t % .&ЁkG4^ XEx!,p&mnI @z$WH: Djh ؾ>VeWody!F5z/xKU&^ד fF8flUJnCsRښRAߍ}H}N x=+`6@<9.w#9F=3ڳyA ,O-6uNu@l]!7luJP 3KV BO{oLF;{9K,=G:_GM =,{ 񼷚V"O\$s)Zpi5>1&cN%q1>y@o=-X6YyM]oIjIdm{63V* KDcbDn(L4ysP)ΛT*9rzD"]ft(B?qcEyLq=@ղOyi G i[iJP3D(dsz-b*@{Uj̡[<%Rr(H.2c,U1h.Pqs tnPzţ ` () H'l{ۋ fGS6Aw-d;s.0n->ؐ ;r)p ` _uL$,LK uHT7jm^IiNW*őd<[Yjz7 p2GlI FSo]b*Mn=p ګ&U_e}6:7:H{ nKJ/佽C" ʓ0Y nEe애y5gxQi')}Z6؏Gu>~TO.;MPu8b)>GkBZ~҄x|Q ?CPS}?"&k_4dJ=.Xao϶\ty x jM+ vJ J㨡&xkv _ߢ}Xו6EѾ*ng h`Z ຌg`#dJuiOdTu}cf@%@@3'=:/<i rӉUւ&T)kXpOB4ҪŽ2f4LZmJ㨕%1OM+I.{iFAw-C~c2rQ4juZohJ-ZR )wFmqd%mi+%!/%^,$d@(2@:b1OOK-eH; 4EZڹ5'ڳMuNۓ?{qU_5}ҐRΤ Μ^[8 IXNXw+ q~y?7JlTB99[TmvkB)X=xVK0qje wҳԠBTJQ?ܷ{K@A6(qݰLn I@G:=uinԣ?erug'Uks`( 2'070,U V=ť蟸 t)@5>~[G |9ڽ]ʟd%3]b ~,?gYZlW$8ka!bOQjB Li/M?] 3>9ݍ2,Q$dׯ3[fvyA ڝw *o2|H3U WǬO8ec Ob{77f݀^!B.ɍ]FaB1-I7DH?|+-cQ$Y$- .@Ն BY s7cTMʰ8B Oqx&*ߧȚq;o]Y<)+YFy~cg!3tl/Zl A'c,'\Ђ]s⊝S]YmTHƼI/L xஞ[LT~IJs?}U@:.\iYUƔTzV}Dz)q)W;p}y}ht~S1 \*^ekx>tN%+ FG0w7~m 3p{;⑋:Yސ99l:O-4 lhpD<"RqIuf8C>[*SuL Kf0S7NC/_(qh?HSp$Z1q3ęF ӣe3D@2H Ѿ2})l.>ݘhc [Lmż]lblmD*^&¼3|^0Nt =a #R!*?}9VnFms$Xj؀c7<M5/EC]9|wƟ́cG(Gpt@:G: a/#*,? vԊ=@ ! P}1Q)Y7W(' ` G3s߆5^dx 2g5 l.ߓF+#o*RH,dXf:eCtqE*o)D#+;%=V?f<1der.uX7SVlg-U`3+O7?ZQMtHaمHWC Bzz3/+kfx&l/tų"I Xv SM$c>W#lC}q3vT֏EM dK xmXC;B_ , ϸ1#<Sl8[X1ji97!+'qB%+$QJޞJ^{W̸oyVپ9?v uPv/VpUt8m~?+uL`w{5< 9_XeoBry!r%ܘgW4 OSZ@˕"ctU<7 ?ʆWS4#k4^9C4/a(=eMD|;"?܃e#LE#}tݟ(>6s%BnhM˰O= ngòe)u$nv#QRբH1|ZwEָq >/b џEhS ǩs" rtKsoեG롛2~&^?z~OAen}u+wu-M3oukGEOťFԍErb&|*Zz7]:"mvHϣ^pY+D~ʍA nͥP#*#?t+`dzߕ5#n㟨3UNEE $6)էSQ81"Gx6`qXF,ӫ9:|ND\ 0+ir {\.)[mHq9$ ݷAmILہCdɕ;o̗^l n%z!in=__+̶Zrzj"[-FWjdSxжZWg^zNl y*R Eqj{ڷ9/v¡`Z'Ueʇ#3ʒѱȘZN+@̰=+ߋw61>O.p+2JӠ 9H󻪖um#d!m&1B11B6~\,z:9uNSE]B/0gjSPHv{Vq3͒/R]ӆ%WCT0i7N [l @2nSjD\f}‚唆?~Rc=QʮAGV{PeF~"Hl0vfhTA @^\HBP0=h mXJ":dޱI‘kMŢc(q\  V 9ؔ4A|˗BͮkT)s GDƖ6y秥FDo{Ȭ.$Œj*}(bD✨ Xl;*˩p$՝ccu~q V%ORZ>}sQ9eIAbAݩQ r?xQn!F-ǶPh6)oUE:ew(|5&O*DmE8j"ЌryC'AK_C5LX9>Xh& ꍲ:89kDx)ܑuK􃰈-kXtE b}mH/Юd#7D8E5(cq!0Ly' y|t^ v[G_q{_IlKR}AʻtsQ-T#VM4v|ԓ 4:-{zA\8s8Vmo;uf+UXx~΃'73e41G@\rf0'}jXe̊Be&F^J~x 평?ܿ@Xwt{uKQי=plx[T/3k:h*ݘx#9h}B>XABf``#տ*Y/r9gQ巂2+kDbQb19B?rA&70HddQU鹓>2;u.wYP)w1!r'!)kmKhIu#wCA xUo6B5zR2lJ2K]t8PEBie+JiȀ)mDFds 'j`$@%:le!;2'(HIwn:X "țR L7[2A<^@kb |#2Ո?;if%0CS{6!ϥnٰP_kr]-x+B紓5RXg7K$ ܫRUM1"QȤp[k}=EI"2tdJ3]:%W_W?_a MYKb9}STw]_;\[_Bl5T \s`Xa$hM!Vš/U%TcfjT<%**'tlb0L r륢CIã} v` i܆ڄ,ĕn,{.`4:WUX vb&UTͩDJSq[.`[; ?Eѡge?}SMw׽`-:~onJa-D~ +xcޔpoldzLp-CvFg;*R^KYumaSۣaFv]U.̛=Տc+(,K"\H~®}2[Ѥ"Ȼ;P꣇Cg JY7I'ف~>Ԙߢ҈.WLt@qCjx;u'eq5 0i< rrD 6_EO%f67낈t Xw2%MnT`oPU-e2T)-[N7p=w YY MiB4]X V9CӇ +x9@5aF(3ҨdtM[c"[ybmctj+lS+kQ-[x췎L6HE0l#mӘQQvۤ "*27YN(KT:'&ہN6NǢ;?P`fM<`$/JG=Xo'“9Y&iBeֺx ^Ԗ NQlw𑾺 R YO@4cNo}4ov<z[ٺY&e%~5 pyWrS2B WrH+`~vHeDuFdXѻ~oq7K]ǫ2S:YsBբ+2*Rynj #" ,W֋P4L N#$?olDN'[vdp.sY{3Jۊu|u,Y\[0H (+/VtW?k'A !2 QCnRqjURI2 ߵk;4)zK~^䔠GXFGwH@eu2v,;V'#^7N|^.Sp9kj.ZdibZ/XKrے;Odc ۤ*䛤+Y3J힟+w "نV=ّ7vLj;c?̪<ZY%Wr%Cm[&Qٲ:f[{/WhyBAbb# )vIwy;rcTYYLjLON!^&77 ]M腖a1y(rwI.J "˯] רUsstKpyW?v@GftI&Hae";k¤gs]Xol.gR%aT#3Ύ6/~$ ӄ}Ѝ痿jLmt@4Kkp_:.ya$]56 3fFa1Jiiܐ"$n!K.ʇ;)ӿmTaGEji\z@q*EGT|Ф_g]7Ŝ^4al71{ *kAlUA$g%nqG C+O9PKOzq{E~UBfj9)1{ ̽:/>pЪ+Ok6.YUύmކaJw,{kjJZze3&zY/ѕ 056sA07_y2G4 ($ׯ!{,cka3 h4⯶@ߺ3'i=/<Nm AhEx=/jICiRJDq>mԴ.!=IxH^]䩁1Fd1l =]MeS ~l56VXvje,r0otq\GhlaEbԖ\~2%|"XBS0]`s6" uliyd'o(TZSǣdqTEs!5hW[L1u,͸ lTK;LŁa6v2-W4hx(!(݈4XVnV~"3d_iiD 3foĵ3/>BT?Ra~Qy峪!xjˇgGq$yƐ;B_T<)ug\21S՞62VqIDr'3=B ]qX2Gvo. < Q~/CeYpѻJTKW_q0я0` 'EUr 3,C_D5U ;.·yGB(xKNn\aAA8[ qsXao1k '.8qEDdM7gLRs y.ŏ6q('S G,aF F\G n4X aE^EltL_[8J }>{8Frln\G03\?XP t2@! aako*n ,o{/0zv~:jXcXuPQzmT^ybq,Y=->{>o,|K/! N: }EU'|&JPh 3"׋gh!ܐ_P p`h /ګ4uQocD1:+(0Mr^U>[䵢[8@G|'L%e 헬7HԾo*k7)PUIoмIS rN HO!ų)ZFMt$9oRwu&&Ê.6L؉JV:mO1_oU}C#x># GhEtLR:D,*mrAC~CpWs55BG]pUGLezBPM=]lj=n @ΌT'5 3L:.%7G,|νNgŞ=/`$!|9[-Cvŷé.z[Jyf:fm#9e YGEhIO1Vk'mOF~A2r#O4FJCP,{oJN蘿̞~{@wϫeHQg־օ^ޣ˾~sՓ'cH7xctɏ.p#}pJ夎86W-wmK ʯ2;UN(ix۔f};ܰW+fKlfK@g$QI2N4yM~6XA|xɲ3*ϳde'ȑǖF!AԼArB#P)Q.ߚ 9&yƻ.oOtHgbg*MY6װ0`ãeݨs&ZiBJ~gDcp2[m7 ,QkNj0hg 2f._!se;pJ"Ae (?8:ʂ@Ri}<7")ƯIdE~8&8+Jv0WVB`U\IʓT Dj1GE-Dç]F?GC D33bVZO#; "-ѣUP~W-s^w;4(+\/s+>Id;^ gI1$W|#'恛dR3n "Sh 12YqA/HcJ8j$ 1UQqzF HKY#.#˩yxIi86=DёՒN} $Zk |Q&8 \-hvmva`XSB }KD^Fx<Ѳm4If(6Ҵr0R< I|p`VC>#_f:+P}1GCT^i99Q {jhV׵[pAL$ѫqԟ(\KC]C:B$?4?a0*,:` 26Êe$_ezǕfK>Bԟ88 _Vp<;*ݤA: €)g3V"ĨA8$} oi˼hTYVTEgi^ZQ~G﨓ɗ"&[~4hzOR'+34Pf!tK/L`̗09"Einpڰ$h !%75$K(ћp)0z~ӄ!F/ӮWgO>hso$Z} ï(QkRa bʋfSS$va,̘wH)I.)ȯ. H0IeID2| I_ʎ%@56~| 8`+HX?|Gф: !SCҳBow{ǭHd['niF*:,돤 \mv 'B.JYC벀;U]m^ 0DS|M21{~$po$ R\x /ڮva֛wJu>R5_,˽jQuX2"ٱ!7zN5Ufcit` v6Vq7S ci<]zWWI5M'ꑸ.ZJ?b=BC)kT,7*Zi> ~vyD0⨙t#Q9WHn0fOb#N]9ZRzo{LX|Q|ULYP^\k֏eRX@bJaP)(?UQfL1T{ IMz|-dۯh$` i2v92V"yPulŮz\ ٪R=Ek ?; ( uc: !NN.ԹRG_&d z"j464FY;n Ǜu3ۮΑ.\2?#ǸKI~574A)dMYfcՈo~ō hDJ/Fj#<` J}5/;]6Y=pysoY'!\I- 2fdKqURqR\w)<^(/ H[# )}%7^ڵy@$RA Cr.]㐖9+,Iߜ''F5h_2 ̌#&qDKbL(N.; ʢ˒1PTIjL0(#$œG޴o`5NNi[{_z,֥l \ ˙ 4wzsTȽG0wx8J^ԖGM+pp6v'ANfqDH{JS4I2wh3O踐 e;UC͙;yT"*\S؃|YR)̼bRY, ۂ^U>C1,[~crƆ}`uQnO31IA9c&)a]xptp0(e#KE}5)u!>wo"A9lS]۹eA a봤tИ`QqZ:}--򈩶*.AY2#eY;ϝ"Bw,9*7,1^ c_#~7KkF@aEsKOūPfSc#LJvCKfk &M^7AqYҺxK 6ز|aI:j0>1< CØcJx'פqyv06v*l+bN|l DWQl/ಥ* yv8s7=`czK; '31@؂2L 3VRԼO sR3*ęաv$kuH?ǑPFZ2!OnMZŵ*=4^W]c5)fpƽtvMdYyu7vВh0I * S!R?r``_(f ֋$JKBݼٙ=}w~X ҷ75,s?e,#۴dϝ[n YT qCw&_Ñ',aD]zZt o7hFWu2*j;F}%o4>©TGn:ݰ8&GC}\^b ΙzZ0+6x˿}>GkWc >EFi hT {C2D-XᨁXcWCE:VxQ1P@F%+ʥtr6< mbٓ4gA)vl [41"oZbCCR.{!I! Y&aT5K8sP*O]l~#_5,5׼XiLMW`xeM=%{Gb/x۵F4prvʦEj(# - @d£cL SBcDlRFcL PTɇ[wclSeIn$an2kȏ!d 8S6Q\ =~b^=mɴ\:Fȵ]ҁ<jU2l0 CSj *m+Ys_&eLyw&/|m trGFW HRkWT$~/Q^sS|K|=xX6`־_'M{钸"Ǔ׺LJ1e*j`'h_}8U6&g}RC_ISGZzo8T^=ӞSHniz9m:= $[J!ˈ҆}i6Yy,_ #$=Zy}Ozlo3 :٠٪Fئ\(b6dhb~w9Q#B7o-.ol/^uj_9;9Kٺ;yOib_.K2t=JYn:Ѡ39VBJumdzɢ{ +j|:Q,'G2ROF ʠk {t> 8<@30]-jcqs=K}#1IkR$z' VW|J{νJZ{WWѹ, Bޥ4?!0]lq$ ޫ%FӦ wta~pp&)Gt2dWyq,o^ d\ O:K G:7(zHvk4XܹPWyr%&=N*=VV l 0$Q1KIAկ 2c;F2uK@d׾;g_ڇn{NdJܮZ9ب^R)Y|yIzg?Z\#{`G,\{G@xR7mG=  v}TZqbfc7|׌^C-S=ShK[W|6du0ޱGSW?̽Q?˲9=L{L~jeZQá:+UnsBs NM>^F+nl/8 hU,qհnc싿$m ƴ/; wyqoVpzXqy D$3c7*|6Iߘ;xaGW|*Nj*8&;O؎`sıH PqsKM]k >f%;TVd| F6JpAf~EgD!i|ۈ~?Ҁ8)ucp4mje ϛߤJѥ6h[p x^!rqTπ+p8Pͦ*TP&GPx T.̕5F64ŵʹlZ";`C(1 ׾{ԧN1Aϓx7QfX@&Ot 뤉Ml0ncM{}oqg1tEA 7L BcmМzpmǀ( 4F!S-3,2+RZ sm)le^W )>O}d",b}')m ɟX?cջ&Y;fwPo[aDwZ|Q(7}ESB_.On= Fݠ/>Y[B~$Q#MVKL$T]̙I=pXwΫ }X,g02H/b"ouexo%3A g}~EmSe9 €=!'Ǿ<'X* r|!v4WcyeO;[jr5 w14` ɶhwq!+=|!W:L x6Áv z3X;] fL ZϞ$98EcSK?\1  .T{T+[ŲG}`n,pOHO;(9{% ft r٤#{5Zgj 05o=v:_65ᑍnt,jfcŋNOp3 YԘkASqY@n[}irx*M#2Wڮndq`LdA m7˃GHx/hp7f  A/-ElΰcUlCl4l[Ӱ ՟¢+D:yVG)pF d@d;%22*&ON[%xGN[Do~.ÖaB"ׄ;ԚE3Q˿Qt' VzY@ 5:*j8 ZN(&Xa4E,6}{hfm7 'dhr\2vyʣ"N?1Ȃ'M3`{ݬD)vǵJO \ZWf2 n;Ρ;L}=sűkN%8>%54ȧw:B %sA56Bôn-$E&dnĺVy+ɜ`\N+a9dQ5H9M2ԡI2_/z @L ;fNA%u,A v5 mJY6[݆MINA6d@7rׂ&qOP}AV6RshNRe)ӑ8aPg=䤓o#6/ _Z^r0Yw5ߔt6:V +$E2ȟYM48fjBG\5}uld~ JJ_OG@)?܌Dn qb JTo^lD VpfI]#OKnY (Cg<+@.9j**"N-$S_:NR*)x ݠeJ$iъc)XBhj9zIQ=ñ^Xzhr&G:`#TCTuZ/PuqpBX߹gnw#߳aѨ칆alb iӔ9iwĪCz 6^c`H186v -^)i_s|Ūi\Xފ^!@@ jLMe)G%vjK Yag{i 6L?l%"We/a>eJcsN3kTGJ-DvcY>RsPd4f@ejɶ@=O]Dm}L|ďzVuO6< r䯿AsvO߈ )O!arE2ARC^[9Vԗ*)*QXҚw @&xB^8/o./Lk[Ex'>eA[T .r:;jSN/q@Ɲr6r[\,V>`բX* +`KrJ~(TNxODuǩMւ<%@4o`itW=bBК8_zo r&HrN|-|l\w@Ves\vεߺosY5Y}IU ?cA.ݔݙ$1ػ]%/^D(6;V?$1(4>"} *78sC '" !QMZKnu.ö g:OWmŮV9 﫿3IYyH#cezT뷄yeRXrcG[tE+KG@Ls~(]}ꄍM-u7MD˅_M4EG";ir[h8/mLMe`js;-ܷ+SՉxQXv~ԣT"KPIٳ,(ҭ{ aA[p&H ,e?v0t`C˿,ġB!;e ϕS EFE7 ; VzI򋽀sIr/ύz3#9?T GaIAS>XցbC~;̀5D^* 6(~}7(Чѯ=5:T ?lTMZ6oỎP~ :SF"xloC1TD ;&mfBt/YG~:HRg FQI_ 4`2==Yh!Kmm>(' JnG>+h/Yߥѡ3 W:xBpꇵ? {fCQ`TMF]xйp~ʉ\R%#`KĢʲN][%,,Y^[A^ :4#tɀ\ֲs.1<1@:< V"|!>{ojx0 R̝I `#nxJ)kT/ ڙ"I.Yɲګo" 41-0OÝMHYyn<+ 7=HlD 4k'Zvb$^H ]:h~PV:0Z'3懜9)dYeq\?!W$.WѺd%.IQ[l;akt6cO M k+ zQXX?Cn3DI7΍L D&{pTAY%u+^ÔjYK[*l/F]XmxY-+ނ(Ftصeeu]` x.ߠɰsQяH*R5:a.54>.H!sl!hEC}֭iVFS&frmZ׸4U@kTAd{ks>WDќer֬mps֪:]3Y[qKVE0@1 5Ih^ߘ4",/66 ++v"-K8؁zCI+r i v7N;;x){9׈dj)NC8`[ 0ӲHYl|o1GbG"dК"!{=2E)Ѳy&.T^Fy&W @A0J򵀹p)RBg<\QbBn0DIz[Erd,4ܧٲϱ4{p'Kiȗ)h*AcΨ<cT ѽ&kh$|=l(;̼,Z^lΉ/6id;7 A'?o}v&M,g-y@C#Q{L6RjD4؈4)4\ 0z\'2 F]5p+_K#+pFSf^rNdfִ3#nUiÇ2k׌,/]?W=l+TQSC{˔QqgMA ,wBC.cX"cy4ӰzЅ r:NpQ3(+dmT-[)yp!!g[}OWa'\hо.Z4)bԔ!,Un}Yr界u&"Lk='a-nM w]+^1K3lh CR 7@ƺGgp?){iM%q]upp_H=fhH8sY6`[oc$WU#[9H'`_,#'#/ߗ;Bđ$OzxDN1?BTJg7X'`|n/Y:Xa܋kZ~h iƥ n{iZ0uF%ML0I*ܽ/Z]@/q` x@DrĤgo&G=JFav'^\Yyޒ.#kи{&ٓWn,!pSE^[x 9qN[<: >_فΗMV@rNDBXгlrő.VI\|#]N>5vbXj>'1DZ?]p -9i:qDc6פֿ=B\xKv_zfaΚ BUV;tQ44Vw $bՇFLS]Ҥ52iHwb|I |Y2rHvL 5kl:h$Nproݬ0zYq'x8Ad"xO32w4-x_4$*vڒ17sj!]Y̵O<|T c:V! Ƞq"jceLp4 s`&Y?Ifo7+/Stn"i"ڦL齼O>hj+!dQ^Jayik듳VbޯT1 k,>Xf>'&<5z>Q)T]U%(>RsjG=)(TьBc\4s#\MU?C6._Áł{y klNxITЩ!GQ7] C\gm%U nԔ^>sض\˕{{k e#,x@5K m+H_SI4LwdߎS' .b\$摒d_lbbg yaSy%oGZ-fur#3 ȷf2_jn~+ʆgPUbFY {ѽK0oKYT8X5*OrdyNU^d)NzCGKK}L}5SPƤd|jƳUG!p.q6J4g{[h4N;|ANVou 'y˄ẸPDH%{vlswWpDL[;]MgfY2[+p8if}Xx7F/}E>Xڲ,Gf.]k%{uLP7{e0ྀ>f^.6T w;e^ _.V&ݏ"2 ۙ^NmHzNcTF  wO0;(u &euttumhZ)Lo_ [$,PM:B}ϾL6Èdr,Xw~HppCvOdaS$ u"ek4t [wݝnl,41i|'y-勽2Yc2hf vP,x)/zZ?[\3 'Z6J:^ 3X/$XS=̄NUs&5TR5Vf{|coRGZX~ z"nyFi;urI3 oۥ~.|Kp6ƅvӱFSu1 ,I;3` &iͬ#/_g'p25pQF] FnUQGWSsP #i߳:zBA[V, UGiRD?0C4,[EPhJI.ģ1/.ߗ36o"V"#dɂuҟ.3r6|po.˶+?it6e1P.23¤Ď݂5[[!i{9~~HYQxo)Cuh_$4SZ;3puYՌs,A5= ?`N|hl5+FZxu5;hwpfC{q፟uxY zf8 ۏ#$xBR4L` i҉zVRlY \[F.}氺hF[]tӾpqd(I"xs@zRBZ^ՑM;A*2+ dxa[V)8{!;&dŐT+ϴjaų{szcn걥0b|(58 ocxBXpIqk9kkG~pI[S :])@B]+ư&2qLo0ᩄ_<ƭ" +[,鼞DrÈifӑ8>gΛ%u4қ >!OXb9/[LCEl*?\qn%B6uQ4%:ߢFs+:)ہR޺aՕYp+A#!Vf2B 0N W AiM>w, /\-u*Y;yT>H˓?FpW~V"8"O=";6Y|Y]ܜNPa V MfJ huj) Vsd-y ) l6OstcC .L M/Y*q HVCGXuk!b^nV e4mH*$֟E:OFȓRD]_[yqC} z5eH (d~I$6+QBZ%-1kY-`&5Ďڴ)ȦʴwC/-(JdwcjMl'JXrA) K%zsX`lrN9^L6Ŝf/1V\N&[Hb_rǟI:۴:\yKˊƸٞq=d}Ru+N1Fnqp΄3&mDJvtÝ݁ `w!UUVHhJD NffJ [Nj@`rpIi@@}z韔>*"VXݛIxA}gCxy3$齃;$JzEz*8 0= X2LY@VPXi&hr{*S%.Py030OڎO@w[@>Hz)YxXEOE'{{ݞv=6'vCT9R;NP|"vT tf"4<|gmg\4;&-B(_c4@6z요H\gf;MeAirαg4:櫸wNB. kr4E e]eTW]= 9= i` p tdp)4bLGϤ:6ZVl-L",tзLȐdOU %A=Q2G3 +.='&v?͒/Iٳ``-q@!-aW}s4HAڠΕoSM'_~wtOЅҶ>9r2ZW\ 򔙶;;T Lm& R 9Ҥ*xZ(YGP,k tIuj9xK>[>(NeN:f_IKADnMݼjaID">JtA 8A(s&ܗ,gG؁O›A%eA0-Y7/J:Hf);ZGLE^%_ VfFhE]aRpDXC9o`;탮BwcD~9뗋,7WUɯ>@>|3m8`r^bc]́꺽6`\{ N'tk(d"OWEoꒊNJ_5I*ٴ @W8`9c \x! F(a{lw~Nm\YfO ,A@ "M/KÜ{=?e#T( A< T['bdo/'D–Kv07pjyaS'S(䴬sN_7fOk Ў|vs샂}Y;Ol6XV$\VA:>A.WYmu/v(-lsGU~l1A q0=$I!jۋjtfxb>8O %ǫF=8-CC$.2EGg& BW08A]2waoyt<>!Sis'\ϋJXGo|$U* clwSybL{/(=D],bY ̯i_y|/OF B;0:`@O'N\|0._+f>T{yQΒ vרzk_\:Bčx9"-7*սSFgs]6B @(CHswbHSbwDg.|s-(>jfԙv^`L۬jc2jtQi!qG:TPhWU~#rL,Lco 5Gy;"oS{АS_tik*CȖXHxT11*c@UnTu0y1,k3CDZAWq߮rmm<)GP8K AEsm]ZtNKI#A+[ѯf1{u)Ӎ>JiË%f5V}GI^[Dhn9 vf>BU"J"\XTd|3 ` 6Sw,̻נ"L\sܕyB˪7p'tJ3K۱+6~̑9 61duV U |>GkHX)JJ&Q[pn9*>le+ba.u!I܃A5X||}pơSg^^=6~.Ϊ*L6LϿ/45{KeO|!|$6.e}r$)yt}oq\4L*;nEĚܚtqq2>`hly_2Nx [w}̆"cFu؛ SKR֓s(x^⦙ȗxwfqg$[Xr]kJUz}XgR[)ʴs;$^• v10PFrz-l]'Wyc3k_xݱbbRn&571WZX@4z5mm[i7V}D6QgD”>R{wӦ(pnq[H _[:sz~*OiT_|9تяe{ [>eu)pj2$z~{FkK_]Zwe6I4<('rz⼇ YsJd1SuE.cU2] :/ІXTi+s4N27R @$eb@6ݦ`9RCEZW@\4dntMكoAumF&x0i9eϰ>v}F ѡWxMlSvB: ~HT)QQ *T Zɳ; K .5 93vնU1˵j k o4  h|p'~9<<,gukۡ( HҐ"&8ҐSߌ.ӻvө+!wRCmO;ZywS1#PGcǩ],l"QcN(ii-.#*ocmۚa՛I`ŗann2D9Fa$3l[L\Mk+k{UsV:-/lrxVodw-(Դ@pISqQ鄚xs{jvf*c)97o!zoa#P PI'+g_n7ߩx QqWkvk~8 oپe6Yppaɘ)\Ys"j&&=Y˒Aoޫ%mr}@:Vhy5Q:t\N2oP'+L#L' J/bXmZF l{3%)[}g~˜3k?1rFk"S2!7x}5 }x:#;tjnR[u ?R`+$ #]| %pRܪ#H䞉;DqJ("MMOu6ʝ=E9 ;69'Pɴm H?3vǗˤ8Fͷ`΃EBܴ.Vr6U>޻#Xyv ͜Zk+wn!wfhw?v5$sĥº?:}^dQ=9$م@JA^F;@Ol)(񪏓߫alEA\A5uyAcK& j d:Mѕ-~"a]j_<ⅿH@sfj?< ˎ=ItvφkO-uo{XX|STUG(ӳg\V)i_ʆSK 䘂.K뺤{_{ZL6더bb:gqB^>xrdY _-񿛺ɢBPlE4@i׊aBl΁G iLؙ 83rS6o=.dF@rfkW.rl݁gd$:CK^CuBu2A Qs*WB.>zHոJ".n dgWTHkoQp k ETYތqR&4щ]E5PCQCȟʷD 5hX@li 5̋[(2 JL2% eƧHZD#_0 H5ES6Ulue„wF-xpc/ȏ#c)1܅Cje,-JG bu^78N s1?܋YBKEitu4Nf!` 6R=S9B'rx@T 9G=[xI+ẗR:A!_cW-b ։쉺 ȄdxFdZc管~m۷|rYuclbnZ[wϣ\.i6Ὓ2OF*2=Y⛺akUX6cCJJf譒كxyqvh:8᱉V6JN/+T/zh컮2X)"$!-+ʳEYOcMQ01SV+Dޯ)ʞ(ՠyƜhZq"`gCbzJ}4"$TQQK.=s`ks 2%&{i?VBG"'?,r y>5<#᪏ XB4_Uw^ J)cu89hkǂ6 @ڭIGgXvwEP2 i&AY\@hnP$BN"yr?Zt x;P8ھ{ `H29"ݲ`/x߇Qd.k*jKX06sQ\$^"Yn.r{F)%VJXgдXRDNomŇ$Ype(ʓRΣMҨ Ccg^~$.`RE'R-ȑPGȏ@Y6DqrZKyo1" >MN܀!'bF'xK=]+A={~w h ltg$%; r츓6@3g@{VaGvHȏgO#YgZ0!i-hyUFTI# &XmwU >9,ŵK2Wn#M[WM5vҾpDp-?4.ZH5@pv{}8'9aunF$uUf`- [o! N2`{?BFZDT/:y',ƅXw#]\բ-E\W/<ǃ\Tw m[걯T|]TnSup墐 &z'a / ljB-أT%kXZEil1tj/DZ3kMV-ΝYcyE4cvnSR*cgO Ri`E,œL/fd74bO%&0 "xhm=uXrחJ' 1pPHɣ=!O,!j;zL㨜1i 1o"pT'}1G^#01iGga9m^6}9P8m?tW86*E4A-1 ,G*xA giMs}Lr;>a U‹$P 9C6t3'n*̰ B4ս d`/vv42@ \P2hY/#7@gJ*>Ms3 ݊kʕ4 w&zecY2'L65yUCQ'g\nvU24Ur4PFqYLʑQ:SnZD{pgȷmuvS;}ƺۘb:> r@_fmsY(Tj1L C;R _t.;uYuY!f֥<\ @_P5`m"k>;H@C:TT\ ›&7 ~'4MsTwvȳn2K?۽367$« ErKzFHVfXD%L ۰J!mñS莮Q'd;=TFdu| XU<srpG%"z.Z#]l"cGƚU Ϧd H8D?׆sBJژ,z TDy Uu9b^7ݺxe ]Db@ 'hK]._] ,p&R(I7^Nџ J,{+#5"xK9nX5k <;?JX" ikC}G*;gOZ3Wn܏留eY"IQ{CGCTdZl臕Fe C#Kv( :CU`lvuI V+ҷ%@.6!ծYhGRr~TL=UOoT7\Ȫ: )lMv= HTvwvW5AF3V8fxz1}tK\6H4t7qE[Aڃay M˝g˳CL:WP/^mŘ {a ߛӊoujߗ.q :'$Ǵޕ{;s)o6)-YִP =Hq2~ni1dlMc^b0!P4t% eG˂ ̰TS{ˊ{y4vwo_8g:;RrM@~ϓ;fwkA|iR&)ʅ 8` _uPjv§oϐï\ EL* iH ytz:/ok3][X*KBJT|c?e97(ך6_⑥6!䎭i\Q,}&.)ĿJ|ՙRϾߚ >ĦpX'n|*("AOUU|1?=Gir Nx,s:8l ptkљFCM~D aaҿ5Y՝ _&{Z|V4۫A.(8(cvϴ- VD zܘ`z== "?D,23a H|UAcIQZp}34 dDlnЂxB/(I(ӓM{ܝj#JyK;h j0x%W= k4g5!oGzbnr1ݷ(D>b пq?/sJ/aY$r;b=q ?cXOX'缃:رLPtUpmwx#kƲ 2aZˆw;mT 1= (Q0BaC͙(c6tM琔L71Fj ԱrL'^urp޻9:=H`^gadTZv Uzԃu>5; KG63$HRN kѯء Wٞ#`ʥʆ^v2CEVU}K 6Amԛuy2D u9^r"a:3kkSiR접&~a,q(\EQ麨l(Ev,d CKʦ] F pW&LPd(mFraB713q%[ˠi2 y[H*O.a:"Z2cC97@ޤ š,ؖDނ_`A! L&by#k!My?WXLS~*% buf"(-w`t5C^}ظ+Z~};o3>@Eu0cGοtVH:*B1tLYEj C5fN^Zk>B`_3+>}1z;^4U "ILOsʈ+Pڮ;;bdv *ho |Yy|}X=#]j_9X[7lѸ'SƻC eNi`DҖb8]Hl1"2H$2+ 簷:ͣUX@_ b}) /:>ey LB|卾'>,1?*ӻs 'Z_y1-qYL|$*C 8Ôr}Zn KiTGq]覝lCi ӳh"0`WamKYI'ߧY-9<ةڠ3"R~ C6zڠ=Fmǹk@͸(\y\ -92k9s0BbT~"+YObOFA#Y=?!Lm!Ealt;խ10SweMĀH,1b릲gP MTN9*(NԑjDfIHU/  D@jƽLq ^]/Jcf +Grw?.F6SmlCdcY0 ,>Ε2,_ Mv~V_v6Z!H:"e+Hqo,fSz=]ҕ;'px}Mِ6xA43`-M=^CuQmm=2!t0 ƄT-Zw!U$ nYjx?w Kg_ai%\<̕>&\^zH#rIu8.":8i1 R$x&o)y I$?J':>PS4)󻩤щ[ ZS>U9;ր~uEs!%Nd"+TcLtz:z`ߔI'C0jW(lcS|{%8pM*'̋^lw3d|txk whNAOv8-Jv.4Fjgɪrק1CWLGKW^JBug]. MJ`ӝ1K gK.S7@FR {~Nsyr@O|@Zڭ9Dk*}VC\V(!&}ːK;~7dÇI.j4_n /[QmXlD(r-x̋xYEs(Uޗ<E3IIB "n u9?(>ƌ{ 3nEmpL٪S$߀|%k0 l2R԰nfdsnL ]̆O?&ޅ1;iW4$^(); O7in &nq- K>J՗ȋ82VJbP(NW@BaunPoQG23,W0Mi :@ CQq@+"+pp@cyk"E`&\ܑK4w$q ֎JHod}ʱ2a.gm/ $躀/bXQ {7xk6(.1 yY@iٙZ@ͪŊ'p,mOrP5rl^ @{X` ڬ,Va1¹{dMꋪh)h8qv! }& "H XLz%\0KчP[ᵉ. `?AeU[-PIrV Wɐns@=⫴C˄E4+><,YbSޡEu!GuN}GwIJmIBM{ҽ8ې+6I_/֧$v#jѕj( ǒqMbu\#PٶlOuѝNh\e ŨO'΢rD )9.sΥOWd<$фdqntGp"CDU A?71ΐ(K XKI] wnC|1L SX_\TAϑ*3'sU%Fnw7 ڸ~:vݼCM~Ϩ [??9wh2{uSXa* րʂfE>DL պ]nݣZjDÌfV zվy'\dJ0[R ^O_ye4DB$|Ķ!ǧ8`1#&<h,.dT%4/}iSr2zk1xI:t!RQLtgʻJmѩKǒ@\aX 6iuqQRy?x L-R]gvtOԨC)SLZO5FlP)EE2d=C6ͭ`'@97_cjJ1 5ԯ^jMɏʌSǖBeP߽!%m8wd'YгF:_ :Ϡ }ر.&~I񰷸gK|#;\_ps=vsamELVٲ~)VFfQ` hE rQ*QERx/_u\>y#DĜFJ0K1RVH@v5`1`YJ9B 1W5|ky௯qI)H¬kjcq 9e2kI<äŒEWTEJك>+%ELE ݜ7;0ț0bdqC{; ҇(\!|a El;~yH?"\ o<lY5trV\B鏺`p"qk}:}fo]sKk9ے'tK_+܃1U^U l̃QVR CR4-^.zq${S64J|ڏp'.J@5.a17\gcnB`lUh.ab>L BXh )*)jQ+P,uF=/VP )iw Ow*PtpGIFm۠WЫn;DB=snL.XV$M-^1VXdƯ us+{+(e+cqnE &Bu76]NK0W90_1utsW۲B%y~qj,J,y^"n2fWGĠk:)K]lX淚q`;0p`M-]zF?; f?) :k`?G)ciwA~Z%$+􂠽PPohGzl̻-.){Vy-˄S44-s} }IĹ}Z'_oC7RQdogpdPvcL߶#aqKã4Es"qFOA$Qv`%\LTSoCplձb# ̓'hf1$sy 9!/1g"e-5b blp}`(W DKտzWRCG (HSnFٰs0TuǫejSr 6·T_]ܾp_&2qJzCȨwsh}PƗvbaRY>XxM;SH"MC:+]#!GHl f^9vO볢i0.]t:Yk𶸓خ\m3,Wnf61IaB[/TWQMa8 !n?&CA;db,i.EXh[dG:foDKW;j6qV8 V_#4)/%tiHyZ6ף͏)jˍ@8gq` CpQ䗈ۗ!i|V"c0a`uCRgbǒTC"W @E+ם|B1{ccFKk,'VH| Pd#[>]<5IHMM$g.Ge8,p2KbDk>[HJ5%`Ms-Ex ݭb FMOGr8E o$%v'5c5#% eG=3enl%tE-=-~<% F6 7aRI+Fg1oNO>/am*B<"P`(3:1 9=2aS ±$rӣ ;th>Zp\=Z_+`ψ<]nu aHxR[}s.A?<\*%5⣚*H1]"NJ>ng{)gKdbA>;}Uil,; tfͶ,HQaka<&@d->c_!lf)onOcz :}FvH'(KiZ߅ gun:, yUwiƑ*=ƫsdf),d9جIrb7vkWi 5b3cWq7'\W&pT8쬮0JZyJW7ѷ;ϙh@(:& iZC0gw#g`O m= ?$;Xs՞ʇjn*qZ߀bpe#Jw(+YnM(w;0}II|ijWUK5 _P#^mJƱ; '4H=j̥/b/>ގ +Z$ M3̠c[DheO)yG^SyTh6uy2ټgg4 f p,aYfެm* O$95!_qk/F&K[Yß(ʟf( %vƣ=<#'<ڎ2CGL]DZD ѲpL2_(0&RcNoª'+}0`>{(m/,"l/o{):;;)Eû)X2.ܒ%[a/}HrYs82BdE {dL7A{㩟 >iE0w3*\Ec=~s bfPx-rh *8 D܄R u\x)ayIՕT)6D"t/s;lSAJνK&XTo1^x [FRZ7@1%@IVqpsEZ"5TlBU*g ԙy aDU{9:L&$гg:%"/E4L֫cz?zc+x(4JwZsnV`4L0o+x!d~zDtifJ˝d=.rcLH`N 6u\ -{Ld~ބ,=ٵVｪ=ѐv\(`fD`MW 崷O,zع:fhtJt3`=l, =SIٓ21 nj-qG81N^ .pF@v2v k84@ro=%Az͊' TRm_R˦E>H͇(]ư3bK\QU h;2 Wf!4ZĒ9Mx@ydGxhaћf LO2p1di5HwҞbn6?%)$~z) Dו|l8/ihg}L}P|iLo!xϰ)I˲=qeυbC x?64t~SO` )+cp=K2 B ӟlհA@|cq^T%sJ ,Nޙnl/kWRښ+~4YDBwpn]ڡ_]V >^X}aDȅ֔pSD5|p"S$$)7bǏm,m;toWγZE\# (ڧ&Wm@Gs3{EG1PƗṢ~ȣ{[; ^&&܊4w|r5 *J=JGL5&4bō"eۍFcLJG(8fGC7^xGkAa\4/e2VIdUjh PD^q*) !69xk[:ͥöӂ ݛӥ#D9tr<KAWO jS+\<+]2Hĕ|׎jDzAYٳwӕB Y*8UDb1TS}nL=5w_%6xQ,c@@҈(-!GMO5%ڪq—U<>B TW̚y㡊W-ڴRZ]S-"7FvY3C;O'*݁l+3bE%_z;-sWn(T+7P?jaœgtҿ`/{|,QʱΌhk; !XEVfz  5uiƐ%adu3iX_Z MJ:T4,j-(Mř)U=:@Hr Ô/2d7=bCL%/g!#1C֥ʯ1ɘu <$gI7i}<,):in/8eUHaS ,)Vr!Yjɥp0cH2EWM IGqs `iviYM WqZ<ZIߌs@q ⚰.R."S ΄) k-[2~[{Ũ(R[dٰ?DToWc`Ќ7 [S 61 ]ok^Q3йE]re‡T牎_%4<a}{ٽ tGFmA{R)b zx!MalFf-`@q2@>G!ۡLmwß@m>G|ر^b@ >*.u'<2,1NTB(9MPzU~LxF+TO?HAi\iY 4%>~5fE%j3*V0?xVZaIX?g'dؼa2Eʺ'u2 U]4gnM-D)SdbK@ e|T߁DB;Tؠ!0?ۛѭ/HZAy^(>V?eU8ʼ Um`U)6ͬ;f|Co!> vU YPmt[䝄@EF:U$'LJiewI4Hr<9PueIF 0XF/{焮`]?l43,OeT\/R4v_0hxWFvT¾KK/ŬZ~>v}+w; HH^yNޘ_=!(XT_ck:M C7f8 2Ф(,0Uf+E z3Vx Մ=pͺMgk{nzM%+(qqIL4sH@ۯiS'eeAv!{*o@^Grm^zuŐfc11JttըP#P틼|)FN51 KhHud:0ulW M΂H㘾I' TWY}냢wSxחKko!d>6Kp}!H8׶_Ro*dEQl=X,+)u۹}ߤ ,r,o(T]IrHʛ_a/k}pWyT=GL~T97%(4"TPj"YSEqݔ<73~dh>*Hi*Ų{&c|jdUV$;j8$ heB~ΨA܉nSSB8k[6f*ddCc~ۈ_gnFp?+6oS¥Q*22lS C$duAC:J@MVv?^b;aڊmr{=CTZ,{fwʮ!Loɴ lMKuٖeU> PtjaVfKSD|x0nP*HHp0LaEEea}|t0cr/ XA!JNJfXJGEg@hV0$-ӽTu߳6) m h BHGzXt}۠˹ xmi&) {t/*vfȹM2)ˉB>7_%#3c6z3o e72eK@]*_߂wtX5G{Ž\ԻȖێf!sg }Vz՗"PM#4c?QZ_cs8װ֓3rD2VBm^OLBHf4Lf?x@2U} s's!k^J1F]x:Y:]*D#X7EYHea2ʢent0yNIB<ѓ-+@6D%%jw.c-~%hm9Kɖ*R4F~d% ︀KO 6-XZAꫂS"h@İIg!|? w,>zH2WF?x,]嘼V Az`b)k^$tGҎ5YεjN-<_e [wv.bLq {rgD ȢJaA)/4dٿM4 Yܰ]tU4oXWcydŴg7AwITJ˺<4y?󆙁= +(eֱ^Vt+PG *;܌U%cysB!ʁmy gXˌ?FOI 4@>è̆y3LV-ЅD@KFڃ !"$3*T= tP:!(jzd~^WM1~lsc(qqfazX67yoY6TmqRW+(2ws򫇼 &`=)A GU/h?$D_ eISY B -aKݝJϏF2NT\\J31;Z} }Ҟ .G+(r*WWpRJR{ f2%Ҍqk5XVjfw.hQX:`\ \eѣ)x~0,wI&W]|U^ d(&t+uWM+Bug, 1Д92l_*TGm F /F ŗaM8׻J6jSإFni_t»7Tk~r3"Y?;>#&fz+%,sPEz_C#\Zkݤ|חt$}դt!83_sbwn+FxH Bdzd!0Ϙ.z,nLd|5 -dYt{/J=FaK_z\ބ]sz&ڨuLH\L]ToǝfCܑ*A],2q٬9:aIK8Z#_Av/;SJLmdL^󎚟m*ӪnWjSU0f6U(ari(b |v s2gqAol > ܈;[|ƑMq{||r;!G$8Sj+EQd3^& -Q8nK_I},\6^/9Zzo~WbL;l1lԵ31r)̒\&vFUu ;p+/*MYϒF|ZRQ 'la5^GF.?5Rl {ډ?Ӂlx)hhMBGJ28*&/*:OY9 \r cv7Zꭔ^w[B3\8͟Ak$ҒTO>#VT,ȌX[Zc/9ٶ!ήn*jk֕ye??Do'^ TNY_GC 2;NswvT uV fr8 Aw{N׳%CXID ӗ8U꽘a".Ry K\gE5{hxsUv j`r0 9p-gmUV $ ~*rk@(`76x;陞׮ J_1,{ע|v(*5r/ڢt0@CNJخFk0/:}LSLR^M@LO0ԕcûL*eV}QCWGHV<(pS]6y۬wf6{ϻ,QJ EZx2ii8Mi ֖}*@EfZ^@0Q50Uu, ~ԯ$}3W!jnVwTVnsICv yV`ӄUQUp ` d>?E>\-?zII0wkoJ6@HvD'w?F8+i^B Wv@W\1Kݝ+i[T%  IKA-@,s;J(J5CO"ꙵu2ʋm,-hC1GvHFnu kgiٶ%s^tK"A A}l66e>PzMWMoe0쎋4* /t^z/*1%yMU, oFj{qF,W/[ӑ,007 zzwJ>sɝE~3)wJމO1 }5 D{t@4fk>nN[EAS#L]碵0ĕkQ{怘!SihډHC w\_~bOMjcaNR|8j?R7 lcr̥ ljNU);N^0a_N|#@PTɢ5`Ϸ}QMçqwaoWyl0Y`eIZŽqAPpuRu~$n @0NUۗ& l+Q\(- k1z26thXJ֬w(VbBXpĞ`)FvrDdJ1o ԅN 1$^h9x)Ĺa61anDWw7b\pkTCO0sWz{!M͔P@R|kw.t$Ij~M;JP.4CI}5f|Yݼ"b*5sZs1N+l'M/sK @mBa_Qqƅf#vA.|U6&7%BVmϚXʍqީׅC@Z_*F!~EgT+P9mNZ `^zui# /%Ztyj; rQA=̍!Clr!bԞVcky642*mc0 `PMDw?ǁxLB2M3͸WW] r}kv N%H :a6U#7O9`e-T!m\᧬}LARwo;TyJ`faJ`T;m^T:E.j)9wg"odL2>{h2L >I$#*ECPg\0MPDZqƘ&wYrY8A2 h$nm!#LAu.3Хs]WK/Vˇ_/`_<")} e$/΍iY$nr |BdpfcFl<:c!D:Eڰ@$'% "%}up*x4 ^:@YR Wc-"rQBM5;[B%@#v}g\=3k 3t-,?̱4iU':;m%ha1rS-5 BUJ<#疀y|Ϫg~ů3َFUGtmlbIB*FmoظLufu.Iiϱiq=jCu4تW`*r)Ll@"a3J.|RhQ(^OxRklHy?[0@[3V` PhW[/q V-'qbF$.a{'nB N(۵8NylS4!XU~¥BusP7pv ?Ts?_,IY4 f1_bs NȇSt&* !R(^v`f %x~]8[aݮ*)2VB4nDPɨ Ve=KkRi]|OV\ʼ3ߏ[rDN:|:qҸrk1XL^&ux_27)O9i\P5C*'Ή;"l!רT*XhN 璃?AZژ+۾~`D+$#2o{狀kCWgJ)J8S-%V^~$WKa tVo"AngQSY=x6L8GhXz%]p6񏌗@ ^]yleFm-ic0 U08$3ChVsA bBNv 5}%}jôP%,;bMM:3*蓔G{cѿˈG18`ցT2XuZh֝ԒFqr ;4Yv {+ ?pgH0B4) Ja_Em:)3 yp-Ruuxt#U|n Y"F/\k "QG +nS)@KY҇!,Vx`I<! ump,Lo|A*%c`j-> u\Z\hLEڬ=%0AIRHWFۈƶ$vupOjcȂv)Q`vw=g0UT'cbؖ!OF%"ES|Q,L;oDmb Q^VuQ4YFnDoő-\f5mdxx+j&7q2DZ@xB?иUA]tc9|b{ȔgWT LT22~s6ld>}`G}i44i?Mhs$Ons4>S%WEL`h'zV<4wvĸ"PApzRZW NIc- afR L|OH{A7ɌІ"DJ*r>aYo}AWI9ۖ``zw"ggxԲȀTh ^؁|kMߣ0~' $jf΄;cJ `P B(rJlb_lq|{H~6c&fsf"QW9Yd dfa/i.+.w@:g.wvFw߾1: BGڛ2't_܆.O/4.0[&ԩgQYJ JUG GtpQ2@kqHvvsx#Ngy[Pl0[NFM{r/w)?Z )wKІլuue{K_j'sƳ]' kF;6#- GX unmmbq{x~1o@!̀|ah Pl`c~Ⱦtw/+[\F<{hcW짶n=3NׁH#fȑz\rJ$,5Bi}-+s+o T~@EXwȾ#Wy'+hy':OIKΌAƌI넨7-<.N0}H!c]R6>[m%QL/ycrQ~J̈JSϑB ai{-U.PiljcyL@MeQYV8WՔ72@Ǎ7L:nobSi* "i͍iV hcxe9P{ 7>s6z3Ó>7Zwy!}E;&X{^K{շ HA%l'| b*t/rsS Du4!S_.{foas*t50>#B3rrQSF}XN PtA>8Ϯ\tu#~dw/:ki^yŵkA(硥DHf:/ö5x CMwсA}:&0G72?Zt-;,qg`H?KĐ.( ?5{1NvH+nV?έ]QkQ\ Շz|i LhX#FGC7䭑o\dфw jʵѩB HS, `àg|OM":;zi՚sGP0v8G)', ~pLdS]8![Xahj~s`7GHnY:"Q-Vl]∑TIJTZCU{]Fn̙6/ u.I8zl}Gߜ\_&}}h䕪_/jZ}eXqu*9*lu+nm"R6q<ܢ)KЊa$oq&.n>D/RY{x*;\ԑ b3GҒX/Ӊf~! LTf۽h2ͥDމf޻@ok>˜&eSZw+CIbfzܼ\Nv}31[j . = J e  :yt4J zW+s^3h~ĵ5|5<Ԃ\-Ɖ.^:z}0#*Ǩ.Ɖ2x#l}O)7Ht*}SZ!KP-b[ ГU*=F&iNϖu4\;oXP{PK*X^0MnyEo 1kPg=B cr{Ce`7{':Lyf/ؠƸ5Ь)xkzK8JT,`GGRFusά$òKw ,ZHeX/ "p#kjxeTێc.Z7HhlQ6/$?VRf&o9?+f0U1E̔#T Txc ffQ]Cmet#v1l~ uF6~a@ׇu$ڸ` w*.Y񴁨8h )̜0;85^̧tWxM\A~>WQX5*>-`Fs:}& =74B/ ö|#F6PF6st rDĐq m0ASP0ƃe rM |YEh5jx] ƸriADE/(d uA|=V^fGppxpXo^ $T/P@^?YNo ߚO tzGM"&Ǩ 1ʼn?O!j<w;Q>Ĕ`1g"{"lloTW%e&t~(kD0;eL%n|F.NGyFR9- טT5yPAl0^ !RRx|Y"Wx3 ؇﷕+ͽ ޽$LX(0Av0^Oe/Vs%- @ʁiH/&e(7 zz&4+iM7*bjpحW/hb3.8% DŽXxYX8ʹEq:O *S.˨~h;qIn +@"v]pasX] 0KPRy6?3UgUpp 0PNOspcjĒ_q^ r Ž~n5k=pE!>}dlBQ5Q+YD\m4]"݃c!]#/ Ҩ&C41C"?y:燱׀ pRC"`GO !{e1Ҿ;Fb6:M1q&c/G"/MWR.rEg"a[ `'fiGmYݹl|Ѓ95W ̟2ֆ3M,8myqaQ:\0MU(uƊ9w>:715a(-O% +=zmKeTq,iVv9cN[> tyAi;CcJ.s)Ѥ)-@s.$2'ڟo9v stTrsG"+$A*Os\#eTk@d{`&G>7@R~]߹DLss_Mz/O|z% 7d8n#Qzh޹sO@~e05d7e#L8ѾR!yJWJ-n;JKOPڇ1@]YapYmX΀A5͛\JpI;h&*3(pz-:Y.w?䚝<Ѐ$D94vV[; hH~PG&J0|:Ռ"ȠTպcVNZlm%NA!ajGCeT8EfαEwMb'an0d@V*5>eC}LķH!BLk:9i`&quhw&u(9Yr }h?eHQnB'}sCUY7OČhbRCMY .!@a C /U:EBֶq#%S}#6CsψN='z8m'ZY1ud-JcuVWJf@(5ƥdf/ `Kq݌/fHBl"hP6p7΂GYsC~n X?Nt+eibLqL-, ɴߨ0JD2ho&zZlO^Sjxyjm~y@/nŃz3W˜)&Q'P L]}hZP$d-=BA JJgv<./}~(8(ߏS 9 尰Q^ץczP hP-S@Dnqq$Ӯ<wu-1P 1Y:8q&9PUo c8o0 ߆44m2IZtt7m3Vtb#fg_ ῿fȾERWp&D@(1N2%W6oRsï։GyU#^YyL81r>&L2^9>,bV($+'mϻUL)A>:.Z*Z1ȃ~S(Lz^9؆>.&0ZTS%^Xjh蕁!&lR7N j<{1Vx#&3Rf:}\La$',Թ>(ǤKg8Dxb<;/hW B^}3t(yP=(;k`t6`N",]2`w \sM~ZNTuCfNHB 'I|A{:g <+@ԙB =1]e=:*8oC7!"ԋI*@B\.V`vʥIQ\t>JKTKqX[RbK!-.ߦ׋̙7%m2>:G@D~E6-LyPrL_0'ݼ>˜:OL*5U9ֿˁM$` U0'OV ՘B&a_XNBB*h}C _$]g !?rC 6`Ɖ+%;JpfԄYю ny[˽oRkEHv~5Dmx~B*1K0PbQ V[=XaSt'\ B n3X QG`\GoA-I'A<|9rB;uSn]VAQlӃIkP|ZmD#foRJRws~Zg`ٙ3>!1R4_Cn'rDF,N\q/k6sEF}1V֓erEz;o9?%BP%{`f>9%j̲UB#Rx MQ8knjA˓alҔ_9ѽ!| k@Vfpu&Wl!cc#_U7Y֌ 6_[,PlxEEy K-jnb9tGShmƊ%RǣgMF?h:z/.rGL@v+5M3ŝQ⬯nzT`qr-Ȉ ԝ{oC Nښۋå3;& N\™]_")@3 9eGc{P05m1 nGƒP#ZE&䤅RU_iNffl. qͯ9}hx`XU lO׃d$8,Z?G˂A)l ttoi)Sy cKԦbpB3)%@}8,o' [oywZR|߂@XW;Vui 3tgHT ]gkTaXll:a ´$-Z[I #d%2WR"ȏJ`ҌOBb>;Q4oځJI:*`M81P,ٯN(C( .z$*>*d/ s~=%+&eMt1jӸfd!m!R:z~Ԓi/O{Uec] WSKݰXCQD_acT0Is?!/um8xxdպ2=hQ`uؐeFC?lI튌w7z317H4c TcR޹ ˶cn`!ZuyTfR7Idf d:7xb[pA" wj+Vj:{v7@:5/Nphk_eG!O_Gh=gG$74OQ@% 0 hp2M-ȂWN!f"U(/ =]Q=VP{kWTv{Z箤HT|bqF\V9'y8R׌U°?KQ՟LYOIr vے,0"&'ݿ/qM&> Gc-<-l1m@rKȶp)ywa`~pԋ<8F(".sŹ|pڽ=־;0L H hA> |._1_ _ W/zoWg%,{Dk 8W0@~x C=U; s@AQ6>w.Ve2,0&Ɣ т#P.1q])VD*ft#Ҹ]s&ZN@$n ${\yݷ_8=TǔIJD= KR$ G0+ 9f%b7x{F9 ^ߥڱd k-[0pAE44hu1{-ؓdb\S:GTS+`Ĝ /OFnmvs~qjX}~Q:K+ၮKL#[{-Y0gR!=FKP'^{iNX<٨N?S$#]8@4ki}! g[$хmoR${Q3> dGKۨ3uQ[m Dc0d @^I^ڦc8l&P1hw'SQԂ'bQJi2s_ SrLWlXx=Z[} ֡VNwc Ʉ?kM!ޱϫRC]M4*x#JseRbs6)_k3:x\B ^0$n]rSosﭞkIî'AzE:$Go&s;u5Yr:0>,W]WsvsP} R$3aG7uLo BGnȣQR#eCJ߈Ejln'x3>:Os9S-xyVYq an Ƙ.~(D*i%_[ wV+o 1?Zku:@8UA=ґz^=U/ؤzLJ!DEb=h?k5,;jJޕ(ܗ|{Mo?\#oD=)_6W0=%f v FP*1ƛC0(Ew͖/ OِUC˳ƏC@7N>Iޒt3hEuau8u{lۥ[\W&^#@o_-/?һ0^vH , IANK wPM٦j˴Nݕ nuHf_Ia/cuȝ5?g4%gez"j_>5'n-' VF1QAKEkU$'-Y脀`Zw2аXDU6Ɩױex{8δ  n᪬ֈޘIKqAtã-'1CQQuU=OJ*˛sn 9t*!DXtj^<бYNئ-|D!yx[^iI1l2fd-dmFv_7j>`&C1XBm"82vL+3.a*kwJ^9lP/}Cs]!)kwT 3nLŏ Zsx")f_KL }X>@}@lyl7{umڤQS2~; a9ٷ*2yNVr*> LG3R^~n}WT`G@rloO: , @E3)lF]=`5g8"}7y8jIӭEWs*77 5u>Px@gڀNBYp1(TYFG\Xá+Tm땗bb[ash!>'j)>i0M&8PT0w(A}C7pf=ݵݐ(߬36KKC +֐1 9f{^e,|zOly0a o_#3{O\H>{n솳/5ҦhR}|5iu(DX{ca1n $vbriMX!!k|DVQJȊhW f(r"-Ns_I,iAĴ1̴+Mz}HN1P*#/$GF= EqTOD#L.nqXF8d܃YaY%ߡkSu`ܶ=B1S{oS`^%A5ws|XBisJT]rvDII^*|Ρ>PP&V7d1ήnkƐbdK,n͒F HfN!$vIJFrgV#'#Wv%^uJٟצ޷Fc'm.Q(.mAH'АD_Quם-Zsƹح,lsť(1jaTLnV44w+;9$l':-b #|P@6s}%0'Ԥl먾eRn,vKMjDdxή!RTʀ[cY$a/Edf|DZbΡr[0E<|lv`7P-[H&pD Y)[UoROJ8lֵ\Gҗq~rOhZFKH-?DZ7tZcٌ =7MԖvnNm=!<"* uQnI8iھG̺, Ujj: zqiŇrءaV(y8h2{&|o$/UɁ4 T'8.5$_4()/sKG/3ȮɀeGK2 ѿ6Lf<jfTԕUq꟯БmWDbԈRVICOi,ϳ0F1AuB(f t L,X*5xvaBC.N]o+'c@UW1(>Aۖoݷ%WV ZsܤJl1ǐtoa͛98g/_8 :a QhFq?2hcUDrPE$wV8]4%woRݰ~lIg3gGpiҾr8mÇ:γHZoJ['U\G@u` WM U`5 #e里AHuD #8-8yԦ VawVF+GuXMJ2xm>+jw:fHn`nz`ݷ:$wROiQQ~âѕx.h׊ampp{{$l`4ٙ~bIV-֠_xS@ogcL ek~zh$X\xL}GENr7A$Ja2Z'L_)fF iΛX ƶs\ˬAjYZ"5ޑ|~B;?{v|޸ťb_ڈԇ3,. _хy,2" @fq<7OqdJS`//yj6*&}?}[qMl,ʞ|"uI&nRfs"acGQq;1H"[("~Šk I|pIƳ3sJ:t/Gߴp#.QNvsLȎg5âB2f Lle /ò]$knwàKY5mF" UNO i )A_97T ]/OÖ62(%8p`0Lrg:tuƤ;&Њ{zftXO E쇽-ߠYm,jjm!!ݻ B9t'}G_{%5H9rd:m(0D>^ZRNd"ͮn=?#{?źČD$Wxv[C$ ݧcK%tqONS5 8ʥZUu?Dm vI7KO`z 3;dstg1헿"`2͏^P?b톝3IOjtp&q=9nȹ^V)bpp.Du@.'e t KݠKKJE]Rd02HțЕ6A^5'a%2]-Ĺ!_Is©/Rmx WY%'aP|"u&f-W_%gkiW omڪIg AM|pw4Bh@90 A/-IǣVkU-9[gc,js</:/A/#}K/崡Qz .) ifH=C ڮ"%'R,a;QuX'!>M햅 bUL#>P~ ͧBX-Tb.L͜<|[ڄ6Wo zZ>;.NWMgWuMT&jW'ΜuѢCMVw['ri{灝_̍Y_`9Ib,vgl}5KfQ6Y/+mDP:/# H_O*^ UG3sBbȊWbuVFvP'Ԛ%lrD\$I|Ch-A\ڻp0׋t-_0BQ*aZ`$,Mw4!.:2,1cLy"Jg7, VYwvQSE 3LإV;%ApH2Cp06ڨ{K8wNoq6L" N rF"x$G/c<٣u"}]dάjsfł^UrAJWgi~e)݈(940HM(v (:COtd2(-)&;ohGP[jϙQ_P`|̤*DJ%RLJ1) A Ҳ=($B(!\niQ0mZ(5p>sbm D!3A]@nK# RL7)w] ;yic&`F]l?WE V+ʍawE{cu&ƒØ馷aҥٟ.f6'٣oMgxJz7̏Ok}NBR_\2XtZ$}kUwwtsA=ZBT FBP2o?)=> xc9Vzб_ht]>i}C/:h[A>aCP7@SB\, +L'Ѿ!48'#EOڄ. M* ZVXT'} 8S9B?+j~&+z \mzZGNQ{a*<ƥz [huU&*vb cfy}؜tpTghXma9D?}⑔P*7^KOW Ev&IV$?Ah%R"_Zg`b~|YM,'8aY)9 ֖*"4Veb%Kx|2hMy\*9NFYB2vI}!gQgwnrz? IJp Gſ+EM7LKTi=HbRGdTB=|iGSQrج˪<$ɈA1bZթ\ޛiaͬ1ʫkȴ~V;QJLdtzmo}TSx&;EvF i05]R-u)eSWlwˬܸad^nG뗫ϬEvd!yКnVVL@ )zA 椬w$<3`@ݕ,l; #&fj1 ^!N$0ٛk Oa_CV#R3#"LjlGq:tD$9; |?踕 _ݪ\N=8'䁫 ٱ:WghI*lARk^rq!`,N*=˃L{"87Dڢw{ĮЕ+,g8,Φބv0- P\2)ruqf=ԟ/IAϽk! pܴb)̇]jwV ;%)0ȳ6oοj9w3xi[~e`#h`e!:39* A}OYnҵEV,k+ Gh,|8`!TNB=jV\-xr=t5\-Dvzݭ} ir: Z6N:]vufu Eg&ss&Jr+;,=Ovun!X+j^h2y?984Wb8dIaj<5t0YCT'*-`ITxx8֒ wqWwN8FSh2 q8P4r;`ŭд=0 4Yq<Ʋ&DاM]t!uūSrQClM2$1UKW3.N,q.tuP/Fzܽ5scSߧ'_ྑ3DۍJxBj щ` KUvSbO*vKSR/9^Q.iM W>]+Yn/UՀ _\͋b9]} r O6ƴhD#b~0+Y3ZYP嫼+XqՍն||6rفLi7e<(zlO!ߑd<☙vwgjdtӰX&ݰA[9}0-C\nl"8b 蜵 !˪Pmz1swQ `IV"E)b2xcd>  }J`qoA,if r";|4i?(o;\;UB)]pT/Ϋ\D7.%tNzG+$f'of,P|"y(85]8!UxYW*K%_{Sel+]`5k"ӨM>[#}S{.*}ӄ/5EΨزIwy  #kQ% /C3VlqH޵TWMLxP)B]>T"+x@~N80A`q7JT" -!ITɲ-2(bTŻt/EF~o7zh:LB!O&8VKnLygHs-}BBW5\jwH$o„mHJba`5 y:9.OPzL;TbCc%G ?ZH4M .%B"!2"M!2I2'tBn&AjҺV{ )t]Joz1LgNЎ59d4=/9\CJV-w^6ٶu_ɭxrpn:.'iW\ۥ¾d%ꀠt`2^XqyۛMA/B/ki!2j/5$i0߆JIcҁ(@6͠k׌ҔxlQMPz4^L d޶~X1Yeȅzmf ڵ[fs|27l)_0=7@`~6$/˿uH&@7W\,bZH%$/$pWի=>V  F[wʎN$4MY$}j}-kuxT4k#mۤqFt1Ll4.|ɛ& dvJi^P`KDۨHsIu:քD8E nuH.1̄HA6Ny)ߐ/KGFXc< ]jM5fS!UR/͚z2dnEC8߄K>/qyU=s@4#`+|Do۰$v 0I5W%6  H4;v Xd"`?|NZ<{B3&Fyʷ= r QC70qCYykֳ~4vsǕTbm oZ3\rcY)njN).R>'WTvYErP[Wd<1F~3N8eu5,qd@o:m\NUMN P142|+͟fn;MC9uYɋQIu)_.c*VKSj{|lc0ڃk{r\x]xoKSb)t;_1A4N+3>SkQi.j;pι|f\~&y3Hn<¯u tS7u۴"=چ&?{iR `qb ~'1%^NȭRa).|h-{qj e(JC`qj8 /a")7TĨ.Z vnlTA"HxĤѬ(!?DGҶ+k ̝^olkev ?UB01!J?qyг-)(lb]s= <y߮nH $gfmQ & RKu=. >EGƺ>"CNwjOQ_lT^{K*d $!t?%h1+1m֑.F3DzHImN+ws5b]bM}O%|e~w}w!N󕹘.NZ-n퇐#<(H] ۯS)cB7iG*2s HUvy[X52Xsd9Eg p:QԖGu~;}vpYsDUQyH^O_h70C n{27_A(70x8@ ~Z:Єk˓ciH2[a8ൗe mC@.pzTN}ps:ɒ7ɠӣx fј[-r c >PhĞ]ݟ)$_jU.䚶އfI^pWr|Qc Q؀PE dZR!rW(v/(D9 ;zug(\ VS^N,y4?㑮 'VLwOXf&niRƊszA&pﵥkx\hR)3p@dbsLEon(r"I(^^x非 cfC4q}^U74ZdV2ڲ#.F3%b~gH5H'Kܣ|j/jDxoܺpgG-@TFhp;6av6 FcճmSUI9`NT5xbB{|t!fE##"n(V2 % t 43Qàt zHMOI7aw҉$,e# ps^@.-X9*d~ Q#{OztmSQ4-P. dMUd1 ߘ|8ū= 뇙we}9/տn>/zpg.Fxx@B>N`s i~o<ێ\qRvSh}&.P uåhbs*bvtK+(}9Жax\ĸjCrt,d ;+@WkT鈃#ֳ^Mf.VYwXҟ<Y.Msh\=wr}i :2hئ)jp3KOFC1C,`W7M2 [$W$cD=YYRb_惎fż(EAo#gdAT ~`:7oq?4AWA_:}8==ȲyR7* ! :wՖZ++{ (Zc'`,3D<^ة/CU/vj] l.}/*ԆgŻ[SQbѓO9.2z3Xk ''E+gG+{#gw >C@߂4I%Ǐ @TJu*9{D"'ͺ|ctWu٥dU>e㯳I[m]>6gVp`Ug2p,ֶrMRA$/Y9Wx. EQ(2 WmYzRx^9d6^@6(g Y1{|[KD]2m' !}wɉԏeђ[ ]i(mOr˸P9Q@I-p#v#ȏb#xC}fOX3ꂎ*( X" T 1ݜʜLᣏg-5 *S&":o!lo\JuFY11eW ØUܩLVjz[v5عrKBx ^ IaM4;G/L:j2gb+MJ)yx?ts/)snE&&;zC)+|7&sC 6:$!?پծD4iZpZf3}Y Vi {CQ5x}_[_KNN]TjCe![]ɛ}oPiE A9ӡ,y7 02޸RʌC; ̒ dmW(‰LuݵntJ+.(M!+q}(6G3\Y L& #1* sjT˴;$e=' \2 syzuz i,ĽҵOUmX E,$8`Ζ8O`;%Xw FAμk4Mg_)s҃)⢡0y'O?&"z)غw1)f`|JFL˚zJ9FؾYԒȠh&V*j s`CTR]ϬW5Ƴl-Sv#҅-~t^8Y6(,)ZuQP%N+wa`jR^s:ǿCk^򢤊f[PiP;CJ\!`2\My(uP#/K~Pؾ̢#o )#sdqeoL ,kd&.1uG\/ U<.6[:l!h{"Z݈Yw;(F Qaļ&P>uaêxJdWE:q8PXylw) ~I  ]~gm@Bh}h: :bX:k H{ADހRBNJrjq]J  2ps-YG_R^-8~̒ە~O뙬 #*;x-Y{N0k{=8KV뒈Pٜ2 ^xQ!Zy*^AILuI|糓jjJT .Z.Ncd,iχ2Y>,MXFQ5yVATRzm%sg1^wxVcju߷peV$lhA1?lgԖўsOj"?d9 4ZAҰƳ[3DF;;ebA8FQ^^\G.J$?uƥ,}7!q{@*]jK։R9on4Dʢ~T ;h)I*DQE"q i-EIĬgt$&!'9 6DEoYU -bs0}6rDi#>U1"le4rCyy5E1ЗC lCsɭ5d{`}@*LrY^m]R;&s6H‰tBJ{w|YUJbs.^ nlBbTrʰ& JݩPRi?.ХR:>ɴ|6EJhW]AlLGnsҭfK>/pD:*ZXLH+W)u½.!h&GJF|壍uA)oFObTjy2_*r)KG{5M;fĤдƽq[yJN#$[x{e=\pnNl9=#ӕ T'K؀{u\L$x= N/(gUD_!MjO#VZÔӪi wnrhIM0P,Эwrin/ʍ;q1CK/Vc>BmxlO7ߙCʮ 72s,vrU;kl9y;il5G=ru7Xqlj㿝mk|"-a(+t\q&Ҝ]YD+Ȉ[u!V9=.@7ƠKISE:}UNFT%99^£v\֒Nx'Cwlp#~^?>$Nڭѹ!*'."G53-ƷobgV9a}`ѓt"\~||be7I(Y~85 (BQ{MV `8B3E4c"=Jf,zrh0u}9Y!wo@OCLRU"^gn)Jd1,Iˇ +, ⃚;Z=Xf/?8jMnv1 lN :cW֊BP=-y-RǨmO\k"PgF\yr!k83(Wf 091fkhC#S3I'0 v{A]IyZ$O/r ?1&AwӂTY4C*i~0USchi[p|Bz!P#B_oG Q\|a :=VOm8Q2 $ÕȎ-~ u%&Zêh|\yO'QspQV j^CD \ݠ{sˆ%0Q k^ĥL jWcXwĸf i;lzޑK`ܳ),^L=f 4jѡ6Vy{~y=E}DW"1SrQ?g0S%mL@^jE^J I.7R1⻈w?[5 gF+>aݖa JKwG}sQR ^b?;h~nZ6ǖ8ʴ]Yb{ r݄jnj|:8$ l:1վvY/];(zKsWΩ7^{^ܞQ<}a@f0BX"I(k;Ps`U:c6cF7#?YȭV&oWӄP9;sP^p%X[U{ыׁ.V1-x55>f6VO!Siwq2JSŀ_oq({T}\;f5Kx:Ӱg'zz2h<ʑ<.V6`CR磹̼VF߸x@U=#KIRLܑx}@ d^{ G-wTp'[P)j2|8D[8Ϸ::ᦵ8HFk8q;{wGVȯ"~juP i(XɧE٥'X|S$Fl|xij=y=շ*oW; %lzІ%L{2[!NyOg{6e15N T0* gIsl4M4~'ݔ8UYn͢ɚ]+ޅ!g&xDh9SIP _0mU,$8T`3zđ2u1 s58:x|R-U{r$bp|ԙg'[pz*2  >W׶jo"'+,0*WHd~kNxr|ڏqD'Fݖ "HkV}=|wvZAZIoYUogٖIi}ז&Xm ( E@#A^X+csR!"Vo1aR;e|ɆC"gQrJsJ" ™&;Ɂ.<9a#!HGF -0Le^\a&߷SP}dyRs'(S'9$V$9l< FNr!Rq/m$7nCN]aaQ} u:nL-;U~e᥵4:fLҁbaLIoJVwH<"Db4ol ;s:gyFo9Mߠo׌O5Q crfqp!L4o9P֏ u\=uUm╕*SL,gGxM6P>n0UQn'mr^`q%/Pm14Vm$!x Pkpp>>WѪM@[4P2boc2!I4w3w3?8ֹpJ2ʭgv[s#Q/S R2G(<\8{@+՛U v|{V ٿ$NYڹ&hq`!V59x /.9#S|n(X.Yr/f ,O%G-u{n/vfǭa6i֕nCjڵ=ǔ/#~c-Welzbtm |&mwN gs -&ݓ"CJbQAmvvӵ^s1W<*/7Sw%- zQ9m^MB&i^PYrud_{`/If wPh.F]Ӝ>#`8yBT>nY1"7ȒK4mɕqIs{՝I<v3Їļ?:Gqf ik/u m%vȠׇQP^*(fW,2z-PAF%E$B{|,xb Y+#ޕ^5uDE-jxoL¥\*m' hSb{$D>c"F)@0rScog>T85B OA vIr+ok07V涭*jYMʃd(c26i&(@{ ȍmU6fx^d4۩Ij/ &c㓢 ]XYCsN!`xѾJB /2A@5_UK]/zFYI3~*ۤKOPl17*]>C_mF _{ :075,~Ĝ~B*{._o`ko+K`A0KX\ 0r޹?B푟@Ufܯ_{u"~,|cӋCkFU\ Ksx(2XTp6td5h *_cdW ~_J"iS KMi@WC;iu|cX@݄e7;ib-9X149KZhgGI1` +yOT:v>7j4$LRCpOiD$XvFݣIvd9wa,k-fKmA=B,<;H$1f6-R4u@_%|&fm*H+P HP< z5 ZZ9P_#HSzkAPJ 6E]/3lt :(Lzi 3_[r[7LU St]'| 囎^T%VD#}E=}8s ϗg_mw\1G7MG_j_݊#iN1h_YQraLZٚҖkPs#9}UȬpE ?Ԫkid%F(r>Lڷ;E2xoz9ebQtTe~Up fctd2WHݚpmRef2[D$ȍsvqA벣Pqrk;IƬϳq.f Ő_QYdx>sKuΎ\y?L<Ӊ|l"G\?;ڧ͜ HSQ`` mhc$!e !OB q~^ jr%@OedЌ6Ll4@u3h S͕;ՏM1_7դj:V,ѱa >zL؈Y`P뗵1;쀔60lT"Iu. _;]( RLU6CZқO#8#)M֔ԔG@~p a WwU?i'H3.3_9jعnm] U⏴r谶aņFsǧ^ h<8iiGvr8M?$JC Ӓ(RӸL\` Q9(([2Qi7t8 .^nXt$`@!|h:[qOYi c!`ۄDV:uLBTU(z,\/>8 hJbil~LAICjX,e>Sk5Vh,M.͙͉ƍէ,&"+@ N7JpVm]O6vl\[2\F]0.aMVV.hZnKbQ×`eqg#h=aA>ՀgP:vCˇ.~Kcm5^ej~P*m f鿠OzehgQR^neHY\c!lo5f/l c=`!PXYl:}kN݉NY40,;wa}"zlj7`9DLL CHSq.O[-ڝUƖfw1Y6寺jfFh-LM\}Ckewh_/FcغM3.^TSWf= nm {DM^% fGw!!-utheT0m8!C4,KYsգzW7= M~QEGj0d¯28 K!$ Yw`^TpA`eaO&M=1z/ Ŀ{"L[/ }fChLE!tY1|AY Rr|% !^0ܩ\fnGw5d2lADEFװp[:Zm-_# ,p̧Z Jsc% -xDg\k}iH-mI:3bplآYY\]>:hށ}叴=zil>Z>MZw&9E]L&7+Ž!$X/?;;Ikh-D\ے._?쬮ɴ0%+@O%\K_};Z2OIL)A{lBzjƚ#)(=ArV C)\c'CM3ۉaW4+aϜ89Jyw{t U$~U/pa>V5?mtqˤ)^[:m= y% jD?,Hjp6 -\%!RbOsu~^W'Uk])އl>@ǘdٹOG67&a@L[ZZUƣǏG! fGbnր͗LGDJ>7Q}?xT=1n:Eu2N\hxQ _c h3)%[H7/v6vc Ptp ^`D֦ "`!*aj`~ qe~vlh.FJ:qh!+*9.@$츱r`W ü=#Ef?x1njy1vvec-o$hlſў,6_N9QO-$]Ee 'oXxD= ˎ/:+UamD\aQ@"J3#9»> i0 M; k庬m;}* Wt)GQx2_a7[GZj=@doﬕJm s9 :]1yC;XYQ {b*%8G`s V$ϩV>gh<)<yAB /FGhV~9 =7Aw<ٲhߑ Qs8+ZS$N(*fze)R}Xo~&勞h?옌풎!O*:×w:CVW͆h \E5N?^=BRi/%LJ?LО:I mW$p67,us:ûGZ6?m4;\g)H.\C|ѡ#Y8WExYc O-i>eUüᘱRʚ@> | %y[>?˒_)?G12(NxP4tRjxܣe OXkLy D ]0*w7s-A+UGZOfa!vx*| W8Jo"];OBWJ$IGaYNÂ]C>}j?_*k,'ȣGtE _f+6O ԛgKB o?i!e0*‰֤F D6StsXE[4'KiȼB؀/# ch;-* [&d'-K/dHy71%礞:!r{X51hls?IfvLt{vQQ(9ZtK–'hBjߝ}YKӋoYdWT-PV!1+ؠAf쳾dٲ`r%&jKU8Vr S;gp,o5z߅Gt_+xǯȣxK#:c\r877Rd/ɳ0ݤ{8 4Q.Vas*IdNBϥD="k2/jhaPmbZϨplE"/\N9d5C}%1|x&``l"5oٱbvņ}P ߸fLJQdN{FWa@^1]Hl|w!h ^'~,R5܂ZF^ȪN"cǿRI{`&D#s!Mb`R|jd!@V#vhUw]>Kt_l.r2d ٶ҈mhyG|ZPS @%+gNʐɛBZ#ՆQ/ Snaи=?p_[TUCH%m13-FeKR;{@\,~UL;z+IVT q g<` 8V1kMv%b!H.dl,ФkR^ 3kNZX)fPo{xBz)e=ב-;_M>)= u@/eEIwO9oHLGQz vzW@|3F} ϴpM )YpN᭲a@Ѿ̠RD;xz:6!>KN! 59nBmYKz-(;nVsd lD&i?4i$e#/4Džx0an뤊 1L8:g7u(z%ܜ^&g}aYZ +ISǜݛ?ܣyq*Au{ ." vA2][tĿ_+ S TM.Og823@l({ey165ow[#^THGL޵)Ӡ#-qWc,:Q%,c2B4)Fah+$|r!%{gD=tU R"qp=>d 3E葽?ʿغx[mSJ+ S1`-c/D̷@㟋QS -x*gy>q]IhIa*РK">oxKP%s#KZe@80 tSn̞ЀjTci(;B;K~ɉY<3(\.nn[|ឥ*In F^^mP巿ѲucʩjBO--!0c)n4 eƸW( Z7 8$'Qj;4\O_o73\E[T+LN>\\6dsׄ U%7(ӿGoXg~0XLV.S~aS>l- W="3 LrfuӌWhS9ӀSFT~6/ xsٛV=rl,Dm}i/dxpCɎg\`tٻN9{M2DDHPUR﹃0|z}P~X'L,CJsDgCU^>g/Lut6q`ȯXq)F4KhM~JXr1xԨX;}]<ʷ=EMB'V]XNS3}aL&yo'RaiJ7W9e=Nĝr(p')p GԹDdf:Q:ۥaZaλXJtԔٮ#JϷ)_Ah+)Oty?*I g 5=Ӌ܉%8g@ E|/%Ok:cl%1.{ CʩcT80@n&gl@c4\gWSW3wW~jkMA:U 5fڬmBqr3>N#/^Da?{ʬ 58<.ى̠AK$};LůZXoXfGN_k}S 7F.E>2ݩ0fC$L~ǹ%V&^[h0sz!`ZcdQF.i n1 5.@Hs ū# CPuϦT JjzV@KDb>P&k]1_(<#jc\r= 8˻2rx `P}\}ࠥYBuiBi0,.=w (:,.&UmEFݦcG{HvT;Bލ6I>2p}z510 1Z ABaI}gG0gnV6\؞<Ճa =)@BEp,u(ś%gប5sA!8P( eꓶeKg 2Hƛd+ByT/M:>nJ- 6NRyvqtRU%s'$ހr<{x4ŕF! 9]#H#㭅.iDW-Yz*>kHQI˸.rqB C0qਖ਼}jDxc'rs%(eĬIU3гǼAh:inћ jitE(1L4 E_]:(!߅}Խ)ꑶy0kv=xb`K5Aq‰+^Hm"[qç]R$ ғL726<38o+0BќM)xhijߺڪ-9stj䶺u&[&"$E^A+sF-t=bLr~+%VwBGI){-ExHbD'f]A u ܆WV[eTZ%# f CӖS.E[:Jg&J!?U{6ED]h`GsS]h@%ȉ%EblĥRaʶH5w`w6W\SPK!2T5 S2}Q}azz,rPF8o)w*z&f=$ڽ89ӚlDz(l;߽[xbqB$NmaR{;4yJ4`KqzUxY"Q#W&B-u(qӢ\+0Fi3JDž8 R`{Q ޿׋:3 2TcSQ̭(T6kHD1R۱ۄ̏|5mYc+sì=0j4׺8N;Sմء\u,XDLɕ7Eʀji2I- >Z1]6)MEľN{ל#nŒ"1|/Ý60gZ]`ԠW` +QpA5И W1ҩP,rC0;sOzW0yk:XzAl-7<1pk|[48P_̔xdT Q'CxtrK)as{tb$c=?2_4|,]8`;1U=i;Uȓ ] Dȅf?wf觶2*@ufHԿreVq$8&e+1=ĬxLj6Z=DŽI Xj j/9J{?5'~`#5S ԛ|ANr9-Nx lMWhB%/UqSa>[ÑN#7O>B 1!/u~, Υ[.koD/am.Dw dDSSmEImտ+.QP)mkyUwoxf(c(#:{Zd_JqRRJ$v`lajGjY̽"s!^X9y׭~bOFs~FxFS3~ej[j|y6NhC`)xcO&G\K1^]ް>õBY6Cr P?<,m}r,f`tqA]5 OCL'=`r:#Ԍh9 0/=os LEF"oɣa0rnALx[U{+H~^R4ɖw %&)GҚ]3}>$ݷĖ1CvS j[BjgXC,Y F]!1ALɬL\B6~bgH]KDfųOdI/sqO/MTM*sZnu ]CTеcWb[wtBUӤ0}S\jD,fRĠIfSִ#pba!.4Ow*{HaI(.ZկZ~['n'U^RU=~Sc:z.>1¡j^T9T*̝0Aj,h,^uV XuL-EA4>Kqw{1y '7R˥s3[ 3zLSc4|~_ka3;J lk/ HH8W( Jوm6 n7d:G{<4>Fd:tYk~OM!z5ZJhTNsw0?t2C^A@XjH R4y2 ;_0bԓEGn9>G9=nZl6f%"A/i Jtm\-D Ƨ<=.fAc0wUC@ 3Om6! dўa󸌡]bYæVmr:oo=G*O bf,DS#@(>w/Yj8m/rZA{ .s7)IJxE2˯S)K[$Cn.S'tV H@\{ydVf+Tc$40P|}O;)d p.;yV )Kq2/4ڗohf|J .-=[Sn\;yAojD88{+WWwH_˵l\0wN5\i&Ʌ6a1 0p*Y!HT&K\3 B(L}xc@*DÍw86/~D}]"j*f:p7zꚨ'IK'U+bdRۍea+}&LNe+* mCX9CW|∏9ECma_^)E3iSH `q=Q9b Qv#[-8ɞ맠& lsMxb>34OM8I7̞1M_1*fW HtF_ErA#;c0 ʨqc k*~2aiV!|S"*!ȠQ:(/gBRn> OqgJxOND62Fm1d^ :\ ҙO\9?M$!ҧ/QވBw`N7"*]ϤԵ]fAVnv[{>l޶0Lȯr] 6>ƹ/| oȶsa췩 >Ax0b` u)[0 xVљ $;>Av2u),E c6~Ĥ菮odf4'zw{xd1]/LfRTHqkoDÄ |. a^QXukI^`#7_fŐ<3H21uJ*m;+IGUm][Th#c ڪ̷0clOmktgvJj_PJoRJ')BxNw`x96 q'pZDž;;6ܮwzjkjr٫3Kk!#9ˣn!u܍ WІw8!%vJ%Yc&oFij/}|<祽BUSyH(_]G@\˞{HCGs8[hRORM6=uPng`Q<gxYbّC9L.1X+=bk-/t|1;IƨK/g 1Qts)AlQg~Tac7@pmk`хmۜKlVIcxMO#)k,qGM0]4U8R̗C' #7og,ޒFz10^>Y; 0G&*v/Fm~wjY>A߷3g!)ƨ͈AʗpX C/:tUJWѼ@!`ryɌw KKa<բ.՞ }Ur>P_։4-Stkg*F  ~Uz ~R9?xlM'}.q&nw}zAO9[rG Zp a7%X [,ܡ9Ք[ eG?pmyc)G*' vYvkWjuU0G9blS EU%h`y201qQ YH;jFkE^XCT@'߈.%o~7ɡ"lf@k~y[QtjHH{ր7iG״"!Xp̺:+сɕ"AfFl#{YPxnA3FC|@n#p E7ri!ʸ ckUM!#G5WxWbB%ϱp59;:PENoӠ6 9Yg^ i%dZy"XBR| {͎܅w\ )~ҰU\DqB[jVLS_=aOEH ψטL_Kڃ/>MSC68s&<C`5k2o("u./ f5DB&[djB% fzl'H:P7b,WJ:\-J{ mQ_7ԻQr$ $ @ˮ $w{PI$ 0 cY1樼B>:T&[g?}c<-t;WٝIL>\KtlQ X̖:-dKFD eR.i\_'+_#]\ʖ{BOhHi\$!*xՓ)}?@&a"ߘـ191GblK3Ki3^B>e[ m-HMR+OmcE5Ӟ.Ppxh}>B" @!'Aq}Ytd"2ynPh!©{;tU>/X-%5Lc'9@LM*2:.<-FKn# ;dt_GKݸN +9D埍0rfudh)*}3Ҡ6O^VoCeXTbu2\~dcnc?_?/)< $|Ԝܟ Hx^lOBf9%W]G}[:7 Dgq#/g|qDmi-9:/}* |- [D4xO1jE JГZ.YN¨ʾg<0}g@8~cDdż]MtHRCp[B;,*n$ (V?jд=|gj+ik[~(%5i)No@'_3 (deXwVq,ȅ$ |La3 86NϾaXB;'P:h OS,~Fߕh.[h uޏs}\܃jzc4/XX'gQܶ'ݜgǚuw+γFB`fe "T&dLX w8 ̑=uVG`hMRszӽ&˯:vF ! X:\8N uCR|irʐ$-pd˕ B*]<%Bµ9 xrwHJ9`-8ʬutq/`U66%{$<^ GGhl$R^خ-wSb_<1=JZh7XAqЁO[+tZJ8ZV\Y EM7jk7/9Pnn0j% gk.B_hwvUW*;HbYL e"08,5^ 96a+(a QΒZ&}jq+LԜi)zUPmu2"nǓꮥn?H^V;Z5>f*=kcufɫ>S eK6+QRH) >sH9c^!siҊd̴lWP2 ;\,Ue>b=!UPc'X0 N!y5'(ɬ%<8#xVWӛRf>wDnCQ ;|1:;%?kP)iyr c Fĸ2)PnK<pRe U.yczWx;k7hFcg(!8 PW] 2&ks}ɝgD ƒPFQkC|dZc[ZcF`WZ&2֚Ĉ_g(v%> sjpuնK}QhW0n=&mDhns"*_=™]eBu/“Qv&"G(2)7l+e0TwTáזԿWh&gz1>kdhf.@{N{e]8/%lDT=4S[B?rw(VS}zqhVD ,WP}t{F=ecU#*Lʤ6cZ1K( fcW/aeSU?v +m7=aJ]Gbv!rOY05ŀge ]n$ዓ]-?HϡVKd_(tryP(/_үc9w%ٛhud1`W2hnl]^y%z:Hiy}ŝ/tdGT_Mxǚ} }k2Eou.e\@/RvXkRB!ZOZc2DVQp*&B[2+?CJnBU)J>T}}y^+˶y )鉢hr4H Bb$c~lCܴwVO"+ieìo7pyf(c=^0TwT;%;S fP֫LUb9?!j/sXK)+Iܺ$L){iY¨#`8 G@B VǗЗلuU|>}׈ `P&kXsB!itZ?.W3e0?l/: 0YVx: QHKk;̣ y$e/1 TP_ӻ dBaIƪT#ҟt+<dh5R{nX^pSF($2(%ByǭvK4X="f7]?lːo-pLJ䜑g׭d,mAxn_ZeG}sLݿqq.Ujt:ӓ jMh)ahrۈ p嵇QjH,MA"Xr뫗F!gZT")g+ mקQza*OtOm?_gP7ϕe䁝_^*c'@rlIŒ[J\#{n5{v¿ύ1~'R-wN: X_k?d`kgBGUaI[¨ӿ}9؟O{5Pʋ'5<.GX%'P~l$/^p-myRQU|Rk/km^g-iɲ M6VrB\=0n?hjn| w"{XY~•8^mm ̗xgV74;+Nym Gy/|M\lEsW U5 v{$P/rWIѼMЖPLtv뙗IeTUE-լ3GH}ၾIaWM{sSBqd?49[Y_n}C,^YQ1׀aK#Gu d)s='`;QcT%1UgCw8|VgVO X';ϰs΂[ 딜gHa|?wM@'\DA1;mJ!ۥA/S٣pfn'{Tu"!#~^qz[z|kXyVdk<>{ ;ay@ك׮q=B;xp=vgfH?z[ק]/=/oL+ZJ53TiߠXd"s}ђRF mͺ>?euEԘW09[|& 2& %I 4 $.]j !:4.!nsN(/ſaFE꫎` ˲,)GqȄ!H’9b=֊9g11AZS OL+ #Ջ%#+״wj{6aYYJ}!ID ,ü݇rr@ia&g< :p!Zm:pTv~PUbл^tO|b膱ȦyDLBRb֘}zWa䶩!|bI[^z|px(~B|D~lRq5Q1GBM2nJ>ߏ{Q̉uϋ泮wr,NrȓOJE Ue1S%T'hE #];k :VC|c $e Ķ.K7D$}:p\w ?":r̞o96'Kٞeosފ 3,מ_@"JK` e1i+}kr{.QXMMTx(A%>xl>F_놼z:[.4һg>uk .f.Tre'#yZ;]j<]`HU^#fwH8Opaټx>]0`5HvY!W]Pe]zrf۴eykHg,Pb <-*׹#=~o@Wu(uQU*1:(9鿥y}j2pMԲ8ua2+l KVpw?|9lA 0_'[W=iNr(MB"j^$d&2yo7Lx)1PRu80ư],cK˜E Sm;}wƾl?5%M[XLZ& <8I͞+`$4ҍ:YqrdAxr+Ȧr B\p9-y`]g#sb&_J-N$IF{@dnak5FUDM8#\kKږVz2S7ZiqU)YLk/\MS.U%SM宂GUD,b4ZA bb}/^%bj[uᏦL) 2aԱ.z 5*AqH;¹d&syMx*64ݘc'_3cH\߰.L$>Lرً y2 :&~ ɛ9tw$D^ `"W$Mu_!moGʤzT4~hnI P '4+G*a+Ib˺PF35au Z" oQ~=HmbDe4NXYfь^?G_ 3M9Ȍ} "{W}&]?mB2u^e),+uNȼ4w` 9Vï,ɀ#KB4)bJeA%a-31nLYCn+` g^Vv+F,DV[r(#"=+0Cal Hѽxp-߅Ed5'at1=U@2c "Mzm >>q.,C z2Ʋ8G`l29[;1_ ٭^nkg/|YMaQ1-6kA H9G%J~U=P{E9gY+Kn;+';NHLy~ `3T<X)3hPI(]P٩} ! n0l8\o!i#~&!nσ~7C}>GYcZeXsef%I 7 XztbD%Kh~" +1 N(ڧi;|lqGܐd3R٠f??ݺi<Ұ Ij&=[ҍ bx d-ޑf?/?T޹5A9wk;B#x^_'K ibCJ;O/fxciL +,ۜu B畨$s{|]Yl0>]7筁iWEF1A˹N-5N RsgIfa7BAmerpBegJW%E2@3(@KE:*{.}XlH׷lj,{KiNejCim*0%ݬԞgt˽ɧ-)*e-9Mx1d'ߍ|>@iRŠ!:,B^Nr4P%̡{%g֙r?i1 Qz,YPxY8ԣa _ UG-ΐr ?ܴ,Ъ!sƏNmotptD\*# 5>>0z9`ryYLR<{*$o?+T俑Q_Y5qVh-5TZl Ϻ OxmqP]oFN dǽUݺOɬW}濎W߆C>3Q%br7>˝|Mf辳G'P?F"ZzCjDGKew,\o\3Vy ;7'3}^NS`&!Q+Zld][06n rÆ3-c2Ƶ È*i o!J`}3uFh9Z4 7P/Pful"i5+T"t'j, |}9V'̈́J{DMb B'׎4q-u7)C:>_%!W8(+fM n!ǹLCc"3va :v0B8AI O Y$Mk*"uh]C e1 L o>J9-z"C,_ިڶZ.; o|kMi3U9UD8IJ?/ ա;ZW$Asjjث:*m +TfN+ϵ!<^s9YzP&xǿ4ËaB`*_+J6-مjz-in/iQ/Б]3E]w{6ǭlv }XG/4Ԩ-o 1'r6LfTY.YH{.uۗP^ '\.f&jhbpۤvTe#ɠl o]&43<ºoJTOx0w 5+6rOoeq≮2p`0h=" =bW~>pĚ~N0YΦ9ěziK5I0@>"!oPt37Wg2߬B20 pHr7 3voԴā=@JG  CM5O.1yw }pr8'lPz.р[ف2خ,w %*-@a8PRHۄAgO-j7Q!;Hl-4c#D-Ï *n~,cQw"҇ 6Z99{ a}ۜ3Q {pU\}Vf)ʫ QqQ~ upP[+Kqq?Sf*2*F!<~|:~iwA`rK*†0&? zPb`kN7nq(P[=T1tdI_8iR3*mcއxܑPҚcP9}IH[(9 "o9ރ~ x5Ss (6ft3دȶ")IcDڼ9I7!O|2.G=*f2oebFd{U;3I]-lV 2$ȭ6f#S:J$\J1龣G}jH" F*MؿJ'B(* IW=j渻-K1W_GT/f%Ky[: _Ӣ΅Dۓ+V?}˂)l`h0>zl4⅂+y9}0`ā'vW1[/ѣx/ϡn-(SaBp FL4ӄT,OB27EYjj!% y2u']&Tv硴?- H7CTxkG 7џBP7)Bxa~Gꪓ،I$qAF4iH"Si&}@E&Hc%6eQbc¢3I1>$$I!Ѻ0 AOG:no#frvߔK]Dб`eqC|Ii>gl &7ⴡJI߭Vi]Y6X]=|,2UX֨n \noM2QYTёXݭ\ymb>)h(6>-_h%IxWT0r}K:ZÀ]4xju<3Hs-x̓+i`]­hA ITY۰)i;*bOfaMipi+^NNw\wn%0Ӥ1{?ի0wNxw~|Yz;ɽȺt&Kӑ"N6`ISE.u(7y M1OANS=/k7U$Yݩ Qg Mi}#\Ξ8)ضnznਨw<}f! p@1[S=fŐҗ:S먉 <V^a8/lpQ kH;2E]-&`-[d nO@jd´[F ™T',mRG^6 OQˑO!O5ȌQmK.SL7Ĕ:{Xciܦi>}(k 8N6R'"iFlX8emZ3&srZg&DFM$%`ՊT_jɤIՠ9 %! c t;kϤ)۬꠼dRNն~G%0z&\B~dTR؈&&`b~ɶ;y:NLv>-9g+tR և&#;(oe!:p*kdIlSԧ 42p1xH " +yAT.1u>~M %܇aa +qw/D$a0ιiR#<Rzn ɦF2A̕цįD~fͲ#eQɖn؉mXE@t-f) K.⥘ޫ?pŧ8_#@>O2 rM9Mb6՝ 3wukB8Ux:7&r` Qf*/gJq% dprS>qՖ6L^ @pmd{.=hTu 9_H Z);7Љ[BjWԵ+ހd%dC7Ὲȭmx)pӾOVJl™ry9S)t<FAowl]2ȅI+Np1/Xc9՜Xj5oIh2 Z$E r}3-cV +R +hS=USPU:aVRa_Q7 BΝ߇hCWb!xSA*tYXV!d;C9 |1ޣPQۘB!gFJ:>AHg`vF`"pauL >[b C c _ӜmRPg4ՙ6gS̒9 ,eӏ_?,$Q;(=]GђÜ%P:-fcb1Rc;`1VWR5]mfOzxYtA nz> spp Bߟ1ڭnaIdU:R48c˵ ZE[GY "7_O=mRe{M`޶^eߪәq6Tj-k-$z.)'Tn2nB<6kPE~LMa,{>mum \U/ E{Øqb# Eg(`Z-DQF%;{5%,صp^Gq2$a(^~ P YNAMy߂PS #|N]5fz1Xw%Mu sYs:kQ\fSmqd׊̎”Ycxbn@ћx͐M#^TZ*iY{v:F^4$ʸ\ܤɁz1꘳pMRFu%V #pk%|k[y{ȈP21UIg Iw)yUҵVx1xsf[DyziL$EOPY3c` s@P dA1 MluJu X+c!K w2UՌ38i߉`*Q4d,H h18$oЭG<ԥ7\ %l="U~P!oq}Cj_K[;ux.9\9iD~Tq[ %lǤ\X-Nu&KAZIKoRRP=@~#dn.C xHvz)wxL#EDo3q0W1W0ph/5T+! }6PPMde"=d9z *멸`뾔Ro7JWC&viT&g:YW4 'Bhxv dǬ4HZ+ٛ2]/c`NtlE4PԶŴ }wXp=sš,iDzCܙ]50Aq;0)K5NE0beq  ~@|q糧E94"+Uy`4/Fw8<,+[[m43vp  ^ ,eف+$t"2tl X_B.zznSZTF9s/`J1n$?=f4`gc',!A4}X\ v8ZRCf / ؃; 51Tzi%CʑJ(;Kd~I5X|v)qz^ )OP7C:^xO*xL )> ;CL[;:E"uI$dn{(2- lN4idPx=h#|kPŲDxZA1l.eZo[sqG¸諥Cv ,*9~X]{Rcd̦jq#rDRwK *BiQLS \\r<>tvh⇡L) +uE]7uMxC5С(VOBQ4+ W) /TrN ;i&۵3 [Wrhat'!/׿$eq@Dګ9Gcah?N΂<0I}l<çVCbpM_2YV^>t7tQ58 73 Q7k(觯I@ۦC ;3$`Bד+.^\? ;0!F%>Xo g8??-H8tQGMӖ 9'ƪ5D`!q^OIѼv,Z%yn[oFHIt2nJEl#rgIvs-—(F>SKez=)8"4k%(EIQl#h͈QL׀j t Ԁ .֙+_|x a~Ws+ ,A{("RDl/%ysrlXn_W}!;0lGkגsjeqo0SȓazdI+aJ\˳vnr6ZΊ%fZ'~57`vq,J/po;RJy= ni NF"aDϕ# ou_6'[i 5RZ*J;2쯩/u؎6iRF!Hd ]. ٯjM#2'/B>'رXI5_+,`rAUa5}2;YqB.rN !/ Bj Lx1Ni0``-kK䶻~Z}?\Ms.މ 2Ou.:y.dA|:"э Ahg7:AZJ jNAe9p wz/ytUE$}QppkOM]v<8 z6RÕnE@ ~N΀^KfDp5a}>pQíX%ApMЙK/ʛZפwPCsӁ~Zbqڲc2So_(}Yuu]Ccbn]-Bޕ#(i`=0Stap$DVj "f8(I<'>0 YZNMF/R/0000755000176000001440000000000012530712567011133 5ustar ripleyusersNMF/R/extractFeatures.R0000644000176000001440000003156712234465004014433 0ustar ripleyusers# Feature selection functions # # Author: Renaud Gaujoux # Created: Mar 18, 2013 ############################################################################### #' @include NMF-class.R NULL #' Feature Selection in NMF Models #' #' The function \code{featureScore} implements different methods to computes #' basis-specificity scores for each feature in the data. #' #' One of the properties of Nonnegative Matrix Factorization is that is tend to #' produce sparse representation of the observed data, leading to a natural #' application to bi-clustering, that characterises groups of samples by #' a small number of features. #' #' In NMF models, samples are grouped according to the basis #' components that contributes the most to each sample, i.e. the basis #' components that have the greatest coefficient in each column of the coefficient #' matrix (see \code{\link{predict,NMF-method}}). #' Each group of samples is then characterised by a set of features selected #' based on basis-specifity scores that are computed on the basis matrix. #' #' @section Feature scores: #' The function \code{featureScore} can compute basis-specificity scores using #' the following methods: #' #' \describe{ #' #' \item{\sQuote{kim}}{ Method defined by \cite{KimH2007}. #' #' The score for feature \eqn{i} is defined as: #' \deqn{S_i = 1 + \frac{1}{\log_2 k} \sum_{q=1}^k p(i,q) \log_2 p(i,q)}{ #' S_i = 1 + 1/log2(k) sum_q [ p(i,q) log2( p(i,q) ) ] }, #' #' where \eqn{p(i,q)} is the probability that the \eqn{i}-th feature contributes #' to basis \eqn{q}: \deqn{p(i,q) = \frac{W(i,q)}{\sum_{r=1}^k W(i,r)} }{ #' p(i,q) = W(i,q) / (sum_r W(i,r)) } #' #' The feature scores are real values within the range [0,1]. #' The higher the feature score the more basis-specific the corresponding feature. #' } #' #' \item{\sQuote{max}}{Method defined by \cite{Carmona-Saez2006}. #' #' The feature scores are defined as the row maximums. #' } #' #' } #' #' @param object an object from which scores/features are computed/extracted #' @param ... extra arguments to allow extension #' #' @return \code{featureScore} returns a numeric vector of the length the number #' of rows in \code{object} (i.e. one score per feature). #' #' @export #' @rdname scores #' @inline #' setGeneric('featureScore', function(object, ...) standardGeneric('featureScore') ) #' Computes feature scores on a given matrix, that contains the basis component in columns. setMethod('featureScore', 'matrix', function(object, method=c('kim', 'max')){ method <- match.arg(method) score <- switch(method, kim = { #for each row compute the score s <- apply(object, 1, function(g){ g <- abs(g) p_i <- g/sum(g) crossprod(p_i, log2(p_i)) }) # scale, translate and return the result 1 + s / log2(ncol(object)) } , max = { apply(object, 1L, function(x) max(abs(x))) } ) # return the computed score return(score) } ) #' Computes feature scores on the basis matrix of an NMF model. setMethod('featureScore', 'NMF', function(object, ...){ featureScore(basis(object), ...) } ) #' The function \code{extractFeatures} implements different methods to select the #' most basis-specific features of each basis component. #' #' @section Feature selection: #' The function \code{extractFeatures} can select features using the following #' methods: #' \describe{ #' \item{\sQuote{kim}}{ uses \cite{KimH2007} scoring schema and #' feature selection method. #' #' The features are first scored using the function #' \code{featureScore} with method \sQuote{kim}. #' Then only the features that fulfil both following criteria are retained: #' #' \itemize{ #' \item score greater than \eqn{\hat{\mu} + 3 \hat{\sigma}}, where \eqn{\hat{\mu}} #' and \eqn{\hat{\sigma}} are the median and the median absolute deviation #' (MAD) of the scores respectively; #' #' \item the maximum contribution to a basis component is greater than the median #' of all contributions (i.e. of all elements of W). #' } #' #' } #' #' \item{\sQuote{max}}{ uses the selection method used in the \code{bioNMF} #' software package and described in \cite{Carmona-Saez2006}. #' #' For each basis component, the features are first sorted by decreasing #' contribution. #' Then, one selects only the first consecutive features whose highest #' contribution in the basis matrix is effectively on the considered basis. #' } #' #' } #' #' @return \code{extractFeatures} returns the selected features as a list of indexes, #' a single integer vector or an object of the same class as \code{object} #' that only contains the selected features. #' #' @rdname scores #' @inline #' @export #' setGeneric('extractFeatures', function(object, ...) standardGeneric('extractFeatures') ) # internal functio to trick extractFeatures when format='subset' .extractFeaturesObject <- local({ .object <- NULL function(object){ # first call resets .object if( missing(object) ){ res <- .object .object <<- NULL res }else # set .object for next call .object <<- object } }) #' Select features on a given matrix, that contains the basis component in columns. #' #' @param method scoring or selection method. #' It specifies the name of one of the method described in sections \emph{Feature scores} #' and \emph{Feature selection}. #' #' Additionally for \code{extractFeatures}, it may be an integer vector that #' indicates the number of top most contributing features to #' extract from each column of \code{object}, when ordered in decreasing order, #' or a numeric value between 0 and 1 that indicates the minimum relative basis #' contribution above which a feature is selected (i.e. basis contribution threshold). #' In the case of a single numeric value (integer or percentage), it is used for all columns. #' #' Note that \code{extractFeatures(x, 1)} means relative contribution threshold of #' 100\%, to select the top contributing features one must explicitly specify #' an integer value as in \code{extractFeatures(x, 1L)}. #' However, if all elements in methods are > 1, they are automatically treated as #' if they were integers: \code{extractFeatures(x, 2)} means the top-2 most #' contributing features in each component. #' @param format output format. #' The following values are accepted: #' \describe{ #' \item{\sQuote{list}}{(default) returns a list with one element per column in #' \code{object}, each containing the indexes of the selected features, as an #' integer vector. #' If \code{object} has row names, these are used to name each index vector. #' Components for which no feature were selected are assigned a \code{NA} value.} #' #' \item{\sQuote{combine}}{ returns all indexes in a single vector. #' Duplicated indexes are made unique if \code{nodups=TRUE} (default).} #' #' \item{\sQuote{subset}}{ returns an object of the same class as \code{object}, #' but subset with the selected indexes, so that it contains data only from #' basis-specific features.} #' } #' #' @param nodups logical that indicates if duplicated indexes, #' i.e. features selected on multiple basis components (which should in #' theory not happen), should be only appear once in the result. #' Only used when \code{format='combine'}. #' #' @examples #' #' # random NMF model #' x <- rnmf(3, 50,20) #' #' # probably no feature is selected #' extractFeatures(x) #' # extract top 5 for each basis #' extractFeatures(x, 5L) #' # extract features that have a relative basis contribution above a threshold #' extractFeatures(x, 0.5) #' # ambiguity? #' extractFeatures(x, 1) # means relative contribution above 100% #' extractFeatures(x, 1L) # means top contributing feature in each component #' setMethod('extractFeatures', 'matrix', function(object, method=c('kim', 'max') , format=c('list', 'combine', 'subset'), nodups=TRUE){ res <- if( is.numeric(method) ){ # repeat single values if( length(method) == 1L ) method <- rep(method, ncol(object)) # float means percentage, integer means count # => convert into an integer if values > 1 if( all(method > 1L) ) method <- as.integer(method) if( is.integer(method) ){ # extract top features # only keep the specified number of feature for each column mapply(function(i, l) head(order(object[,i], decreasing=TRUE), l) , seq(ncol(object)), method, SIMPLIFY=FALSE) }else{ # extract features with contribution > threshold # compute relative contribution so <- sweep(object, 1L, rowSums(object), '/') # only keep features above threshold for each column mapply(function(i, l) which(so[,i] >= l) , seq(ncol(object)), method, SIMPLIFY=FALSE) } }else{ method <- match.arg(method) switch(method, kim = { # KIM & PARK method # first score the genes s <- featureScore(object, method='kim') # filter for the genes whose score is greater than \mu + 3 \sigma th <- median(s) + 3 * mad(s) sel <- s >= th #print( s[sel] ) #print(sum(sel)) # build a matrix with: #-> row#1=max column index, row#2=max value in row, row#3=row index temp <- 0; g.mx <- apply(object, 1L, function(x){ temp <<- temp +1 i <- which.max(abs(x)); #i <- sample(c(1,2), 1) c(i, x[i], temp) } ) # test the second criteria med <- median(abs(object)) sel2 <- g.mx[2,] >= med #print(sum(sel2)) # subset the indices g.mx <- g.mx[, sel & sel2, drop=FALSE] # order by decreasing score g.mx <- g.mx[,order(s[sel & sel2], decreasing=TRUE)] # return the indexes of the features that fullfil both criteria cl <- factor(g.mx[1,], levels=seq(ncol(object))) res <- split(g.mx[3,], cl) # add the threshold used attr(res, 'threshold') <- th # return result res }, max = { # MAX method from bioNMF # determine the specific genes for each basis vector res <- lapply(1:ncol(object), function(i){ mat <- object vect <- mat[,i] #order by decreasing contribution to factor i index.sort <- order(vect, decreasing=TRUE) for( k in seq_along(index.sort) ) { index <- index.sort[k] #if the feature contributes more to any other factor then return the features above it if( any(mat[index,-i] >= vect[index]) ) { if( k == 1 ) return(as.integer(NA)) else return( index.sort[1:(k-1)] ) } } # all features meet the criteria seq_along(vect) } ) # return res res } ) } #Note: make sure there is an element per basis (possibly NA) res <- lapply(res, function(ind){ if(length(ind)==0) ind<-NA; as.integer(ind)} ) # add names if possible if( !is.null(rownames(object)) ){ noNA <- sapply(res, is_NA) res[noNA] <- lapply(res[noNA], function(x){ setNames(x, rownames(object)[x]) }) } # apply the desired output format format <- match.arg(format) res <- switch(format #combine: return all the indices in a single vector , combine = { # ensure that there is no names: for unlist no to mess up feature names names(res) <- NULL ind <- na.omit(unlist(res)) if( nodups ) unique(ind) else ind } #subset: return the object subset with the selected indices , subset = { ind <- na.omit(unique(unlist(res))) sobject <- .extractFeaturesObject() {if( is.null(sobject) ) object else sobject}[ind, , drop=FALSE] } #else: leave as a list ,{ # add component names if any names(res) <- colnames(object) res } ) # add attribute method to track the method used attr(res, 'method') <- method # return result return( res ) } ) #' Select basis-specific features from an NMF model, by applying the method #' \code{extractFeatures,matrix} to its basis matrix. #' #' setMethod('extractFeatures', 'NMF', function(object, ...){ # extract features from the basis matrix, but subset the NMF model itself .extractFeaturesObject(object) extractFeatures(basis(object), ...) } ) unit.test(extractFeatures, { .check <- function(x){ msg <- function(...) paste(class(x), ':', ...) checkTrue( is.list(extractFeatures(x)), msg("default returns list")) checkTrue( is.list(extractFeatures(x, format='list')), msg("format='list' returns list")) checkTrue( is.integer(extractFeatures(x, format='combine')), msg("format='combine' returns an integer vector")) checkTrue( is(extractFeatures(x, format='subset'), class(x)), msg("format='subset' returns same class as object")) } .check(rmatrix(50, 5)) .check(rnmf(3, 50, 5)) }) NMF/R/Bioc-layer.R0000644000176000001440000002231012530675371013243 0ustar ripleyusers# Layer for Bioconductor # # - define methods with signature for use within Bioconductor # - define alias methods for use in the context of microarray analysis (metagenes, metaprofiles, ...) # # Author: Renaud Gaujoux \email{renaud@@cbio.uct.ac.za} ############################################################################### #' @include NMF-class.R #' @include transforms.R NULL #' Specific NMF Layer for Bioconductor #' #' The package NMF provides an optional layer for working with common objects #' and functions defined in the Bioconductor platform. #' #' It provides: #' \itemize{ #' \item computation functions that support \code{ExpressionSet} objects as #' inputs. #' \item aliases and methods for generic functions defined and widely used by #' Bioconductor base packages. #' \item specialised visualisation methods that adapt the titles and legend #' using bioinformatics terminology. #' \item functions to link the results with annotations, etc... #' } #' #' @rdname bioc #' @name bioc-NMF #' #' @aliases nmf,ExpressionSet,ANY,ANY-method #' @aliases nmf,matrix,ExpressionSet,ANY-method #' #' @aliases seed,ExpressionSet,ANY,ANY-method #' #' @aliases run,NMFStrategy,ExpressionSet,ANY-method #' #' @aliases nmfModel,ExpressionSet,ANY-method #' @aliases nmfModel,ANY,ExpressionSet-method #' #' @aliases rnmf,ANY,ExpressionSet-method #' #' @aliases nneg,ExpressionSet-method #' @aliases rposneg,ExpressionSet-method #' #' @aliases .atrack,ExpressionSet-method #' #' @aliases sampleNames,NMF-method #' @aliases sampleNames<-,NMF,ANY-method #' @aliases sampleNames,NMFfitX-method #' @aliases featureNames,NMF-method #' @aliases featureNames<-,NMF-method #' @aliases featureNames,NMFfitX-method #' #' @aliases nmeta #' @aliases metagenes metagenes<- #' @aliases metaprofiles metaprofiles<- #' #' @exportPattern ^featureNames #' @exportPattern ^sampleNames #' @exportPattern ^metagenes #' @exportPattern ^metaprofiles #' @exportPattern ^nmeta NULL # add extra package Biobase setPackageExtra('install.packages', 'Biobase', pkgs='Biobase') .onLoad.nmf.bioc <- function(){ if( pkgmaker::require.quiet('Biobase') ){ # load Biobase package requireNamespace('Biobase') #library(Biobase) #' Performs NMF on an ExpressionSet: the target matrix is the expression matrix \code{exprs(x)}. #' @rdname bioc setMethod('nmf', signature(x='ExpressionSet', rank='ANY', method='ANY'), function(x, rank, method, ...) { # replace missing values by NULL values for correct dispatch if( missing(method) ) method <- NULL if( missing(rank) ) rank <- NULL # apply NMF to the gene expression matrix nmf(Biobase::exprs(x), rank, method, ...) } ) #' Fits an NMF model partially seeding the computation with a given #' ExpressionSet object passed in \code{rank}. #' #' This method provides a shortcut for \code{nmf(x, exprs(rank), method, ...)}. #' #' @examples #' # partially seed with an ExpressionSet (requires package Biobase) #' \dontrun{ #' data(esGolub) #' nmf(esGolub, esGolub[,1:3]) #' } #' setMethod('nmf', signature(x='matrix', rank='ExpressionSet', method='ANY'), function(x, rank, method, ...){ # replace missing values by NULL values for correct dispatch if( missing(method) ) method <- NULL nmf(x, Biobase::exprs(rank), method, ...) } ) #' Seeds an NMF model directly on an ExpressionSet object. #' This method provides a shortcut for \code{seed(exprs(x), model, method, ...)}. #' #' @examples #' # run on an ExpressionSet (requires package Biobase) #' \dontrun{ #' data(esGolub) #' nmf(esGolub, 3) #' } #' setMethod('seed', signature(x='ExpressionSet', model='ANY', method='ANY'), function(x, model, method, ...) { # replace missing values by NULL values for correct dispatch if( missing(method) ) method <- NULL if( missing(model) ) model <- NULL # apply NMF to the gene expression matrix seed(Biobase::exprs(x), model, method, ...) } ) #' Runs an NMF algorithm on the expression matrix of an \code{ExpressionSet} object. setMethod('run', signature(object='NMFStrategy', y='ExpressionSet', x='ANY'), function(object, y, x, ...){ run(object, Biobase::exprs(y), x, ...) } ) ###% Method 'nmfModel' for 'ExpressionSet' target objects: ###% -> use the expression matrix of 'target' as the target matrix setMethod('nmfModel', signature(rank='ANY', target='ExpressionSet'), function(rank, target, ...){ if( missing(rank) ) rank <- NULL # call nmfModel on the expression matrix nmfModel(rank, Biobase::exprs(target), ...) } ) setMethod('nmfModel', signature(rank='ExpressionSet', target='ANY'), function(rank, target, ...){ if( missing(target) ) target <- NULL # call nmfModel on the expression matrix nmfModel(Biobase::exprs(rank), target, ...) } ) ###% Method 'rnmf' for 'ExpressionSet' target objects: ###% -> use the expression matrix of 'target' as the target matrix ###% setMethod('rnmf', signature(x='ANY', target='ExpressionSet'), function(x, target, ...){ rnmf(x, Biobase::exprs(target), ...) } ) ###% The method for an \code{ExpressionSet} object returns the data.frame that ###% contains the phenotypic data (i.e. \code{pData(object)}) setMethod('.atrack', 'ExpressionSet', function(object, data=NULL, ...){ if( is.null(data) ) data <- t(Biobase::exprs(object)) .atrack(Biobase::pData(object), data=data, ...) } ) #' Apply \code{nneg} to the expression matrix of an \code{\link{ExpressionSet}} #' object (i.e. \code{exprs(object)}). #' All extra arguments in \code{...} are passed to the method \code{nneg,matrix}. #' #' @examples #' #' E <- ExpressionSet(x) #' nnE <- nneg(e) #' exprs(nnE) #' setMethod('nneg', 'ExpressionSet' , function(object, ...){ Biobase::exprs(object) <- nneg(Biobase::exprs(object), ...) object } ) #' Apply \code{rposneg} to the expression matrix of an \code{\link{ExpressionSet}} #' object (i.e. \code{exprs(object)}). #' #' @examples #' #' E <- ExpressionSet(x) #' nnE <- posneg(E) #' E2 <- rposneg(nnE) #' all.equal(E, E2) #' setMethod('rposneg', 'ExpressionSet' , function(object, ...){ Biobase::exprs(object) <- rposneg(Biobase::exprs(object), ...) object } ) ###% Annotate the genes specific to each cluster. ###% ###% This function uses the \code{annaffy} package to generate an HTML table from the probe identifiers. # setGeneric('annotate', function(x, annotation, ...) standardGeneric('annotate') ) # setMethod('annotate', signature(x='factor', annotation='character'), # function(x, annotation, filename='NMF genes', outdir='.', name='Cluster specific genes', ...) # { # library(annaffy) # anncols<-aaf.handler()[c(1:3, 6:13)] # # # add html suffix to filename if necessary # if( length(grep("\\.html$", filename)) == 0 ) filename <- paste(filename, 'html', sep='.') # # # for each cluster annotate the genes set # print(head(x)) # by(names(x), x, function(g){ # print(head(g)) # if( length(g) == 0 ) return() # g <- as.character(g) # anntable <- aafTableAnn(g, annotation, anncols) # # generate HTML output # saveHTML(anntable, file.path(outdir,filename), title=paste(name, '[top', nrow(anntable),']')) # }, simplify=FALSE) # # # return nothing # invisible() # } # ) # # setMethod('annotate', signature(x='NMF', annotation='character'), # function(x, annotation, ...) # { # s <- extractFeatures(x) # class <- .predict.nmf(t(s)) # annotate(class, annotation=annotation, ...) # } # ) ## Assign BioConductor aliases ###% number of metagenes nmeta <- nbasis ###% get/set methods of basis matrix metagenes <- basis `metagenes<-` <- `basis<-` ###% get/set methods of mixture coefficients matrix metaprofiles <- coef `metaprofiles<-` <- `coef<-` ###% Get/Set methods for rows/columns names of the basis and mixture matrices # using the Biobase definition standard generics setGeneric('featureNames', package='Biobase') setGeneric('featureNames<-', package='Biobase') setMethod('featureNames', 'NMF', function(object){ rownames(object) } ) setReplaceMethod('featureNames', 'NMF', function(object, value){ rownames(object) <- value object } ) ###% For NMFfitX objects: returns the featureNames of the best fit ###% There is no replace method for NMFfitX objects setMethod('featureNames', 'NMFfitX', function(object){ rownames(fit(object)) } ) setGeneric('sampleNames', package='Biobase') setGeneric('sampleNames<-', package='Biobase') setMethod('sampleNames', 'NMF', function(object){ colnames(object) } ) setReplaceMethod('sampleNames', 'NMF', function(object, value){ colnames(object) <- value object } ) ###% For NMFfitX objects: returns the sampleNames of the best fit ###% There is no replace method for NMFfitX objects setMethod('sampleNames', 'NMFfitX', function(object){ colnames(fit(object)) } ) # # Export layer-specific methods [only if one is loading a namespace] # # NB: Only for R < 3.0.0 # if( pkgmaker::testRversion("2.15.3", -1L) ){ # ns <- pkgmaker::addNamespaceExport(c("nmeta" # ,"featureNames", "featureNames<-" # ,"sampleNames", "sampleNames<-" # ,"metagenes", "metagenes<-" # ,"metaprofiles", "metaprofiles<-")) # } # return TRUE TRUE } } NMF/R/utils.R0000644000176000001440000007463312530673030012422 0ustar ripleyusers#' @include rmatrix.R #' @include nmf-package.R NULL #' Utility Function in the NMF Package #' #' @name utils-NMF #' @rdname utils NULL #' Internal verbosity option #' @param val logical that sets the verbosity level. #' @return the old verbose level #' @keywords internal lverbose <- local({ .val <- 0 function(val){ if( missing(val) ) return(.val) oval <- .val .val <<- val invisible(oval) } }) vmessage <- function(..., appendLF=TRUE) if( lverbose() ) cat(..., if(appendLF) "\n", sep='') nmf_stop <- function(name, ...){ stop("NMF::", name , ' - ', ..., call.=FALSE) } nmf_warning <- function(name, ...){ warning("NMF::", name , ' - ', ..., call.=FALSE) } # or-NULL operator '%||%' <- function(x, y) if( !is.null(x) ) x else y # cat object or class for nice cat/message quick_str <- function(x) if( is.atomic(x) ) x else class(x)[1] # remove all attributes from an object rmAttributes <- function(x){ attributes(x) <- NULL x } #' \code{str_args} formats the arguments of a function using \code{\link{args}}, #' but returns the output as a string. #' #' @param x a function #' @param exdent indentation for extra lines if the output takes more than one line. #' #' @export #' @rdname utils #' #' @examples #' #' args(library) #' str_args(library) #' str_args <- function(x, exdent=10L){ s <- capture.output(print(args(x))) paste(str_trim(s[-length(s)]), collapse=str_c('\n', paste(rep(' ', exdent), collapse=''))) } #' Simple Progress Bar #' #' Creates a simple progress bar with title. #' This function is identical to \code{utils::txtProgressBar} but allow adding #' a title to the progress bar, and can be shared by multiple processes, #' e.g., in multicore or multi-hosts computations. #' #' @inheritParams utils::txtProgressBar #' @param shared specification of a shared directory to use when the progress #' bar is to be used by multiple processes. #' #' @author R Core Team #' @keywords internal txtProgressBar <- function (min = 0, max = 1, initial = 0, char = "=", width = NA, title= if( style == 3 ) ' ', label, style = 1, file = "" , shared = NULL) { if (!identical(file, "") && !(inherits(file, "connection") && isOpen(file))) stop("'file' must be \"\" or an open connection object") if (!style %in% 1L:3L) style <- 1 .val <- initial .killed <- FALSE .nb <- 0L .pc <- -1L nw <- nchar(char, "w") if (is.na(width)) { width <- getOption("width") if (style == 3L) width <- width - 10L width <- trunc(width/nw) } if (max <= min) stop("must have max > min") # setup shared directory .shared <- NULL if( isTRUE(shared) ) shared <- tempdir() if( is.character(shared) ){ .shared <- tempfile('progressbar_', tmpdir=shared[1L]) dir.create(.shared) } # getval <- function(value){ if( value >= max || value <= min || is.null(.shared) || !file.exists(.shared) ){ value }else{ cat('', file=file.path(.shared, paste('_', value, sep=''))) length(list.files(.shared)) } } up1 <- function(value) { if (!is.finite(value) || value < min || value > max) return() # get actual value value <- getval(value) .val <<- value nb <- round(width * (value - min)/(max - min)) if (.nb < nb) { cat(paste(rep.int(char, nb - .nb), collapse = ""), file = file) flush.console() } else if (.nb > nb) { cat("\r", title, paste(rep.int(" ", .nb * nw), collapse = ""), "\r", title, paste(rep.int(char, nb), collapse = ""), sep = "", file = file) flush.console() } .nb <<- nb } up2 <- function(value) { if (!is.finite(value) || value < min || value > max) return() # get actual value value <- getval(value) .val <<- value nb <- round(width * (value - min)/(max - min)) if (.nb <= nb) { cat("\r", title, paste(rep.int(char, nb), collapse = ""), sep = "", file = file) flush.console() } else { cat("\r", title, paste(rep.int(" ", .nb * nw), collapse = ""), "\r", paste(rep.int(char, nb), collapse = ""), sep = "", file = file) flush.console() } .nb <<- nb } up3 <- function(value) { if (!is.finite(value) || value < min || value > max) return() # get actual value value <- getval(value) .val <<- value nb <- round(width * (value - min)/(max - min)) pc <- round(100 * (value - min)/(max - min)) if (nb == .nb && pc == .pc) return() cat(paste(c("\r",title," |", rep.int(" ", nw * width + 6)), collapse = ""), file = file) cat(paste(c("\r",title," |", rep.int(char, nb), rep.int(" ", nw * (width - nb)), sprintf("| %3d%%", pc)), collapse = ""), file = file) flush.console() .nb <<- nb .pc <<- pc } getVal <- function() .val kill <- function(cleanup=TRUE) if (!.killed) { cat("\n", file = file) flush.console() .killed <<- TRUE # do some cleanup if( cleanup ){ # delete shared directory if( !is.null(.shared) && file.exists(.shared) ) unlink(.shared, recursive=TRUE) # } invisible(TRUE) } up <- switch(style, up1, up2, up3) up(initial) structure(list(getVal = getVal, up = up, kill = kill), class = "txtProgressBar") } ###% apply a function to each entry in a matrix matapply <- function(x, FUN, ...){ res <- sapply(x, FUN, ...) matrix(res, nrow(x)) } ###% try to convert a character string into a numeric toNumeric <- function(x){ suppressWarnings( as.numeric(x) ) } ###% Tells one is running in Sweave isSweave <- function() !is.null(sweaveLabel()) sweaveLabel <- function(){ if ((n.parents <- length(sys.parents())) >= 3) { for (i in seq_len(n.parents) - 1) { if ("chunkopts" %in% ls(envir = sys.frame(i))) { chunkopts = get("chunkopts", envir = sys.frame(i)) if (all(c("prefix.string", "label") %in% names(chunkopts))) { img.name = paste(chunkopts$prefix.string, chunkopts$label, sep = "-") return(img.name) break } } } } } sweaveFile <- function(){ label <- sweaveLabel() if( !is.null(label) ) paste(label, '.pdf', sep='') } fixSweaveFigure <- function(filename){ if( missing(filename) ){ filename <- sweaveLabel() if( is.null(filename) ) return() filename <- paste(filename, '.pdf', sep='') } filepath <- normalizePath(filename) tf <- tempfile() system(paste("pdftk", filepath, "cat 2-end output", tf, "; mv -f", tf, filepath)) } ###% 'more' functionality to read data progressively more <- function(x, step.size=10, width=20, header=FALSE, pattern=NULL){ if( !(is.matrix(x) || is.data.frame(x) || is.vector(x) || is.list(x)) ) stop("NMF::more - invalid argument 'x': only 'matrix', 'data.frame', 'vector' and 'list' objects are handled.") one.dim <- is.null(dim(x)) single.char <- FALSE n <- if( is.character(x) && length(x) == 1 ){ cat("\n") single.char <- TRUE nchar(x) } else if( one.dim ){ cat("<", class(x),":", length(x), ">\n") # limit to matching terms if necessary if( !is.null(pattern) ) x[grep(pattern, x)] length(x) }else{ cat("<", class(x),":", nrow(x), "x", ncol(x), ">\n") head.init <- colnames(x) head.on <- TRUE # limit to matching terms if necessary if( !is.null(pattern) ){ idx <- apply(x, 2, grep, pattern=pattern) print(idx) idx <- unique(if( is.list(idx) ) unlist(idx) else as.vector(idx)) x <- x[idx,, drop=FALSE] } nrow(x) } i <- 0 while( i < n ){ # reduce 'step.size' if necessary step.size <- min(step.size, n-i) what2show <- if( single.char ) substr(x, i+1, i+step.size) else if( one.dim ) if( !is.na(width) ) sapply(x[seq(i+1, i+step.size)], function(s) substr(s, 1, width) ) else x[seq(i+1, i+step.size)] else{ w <- x[seq(i+1, i+step.size), , drop=FALSE] if( !is.na(width) ){ w <- apply(w, 2, function(s){ ns <- toNumeric(s) if( !is.na(ns[1]) ) # keep numerical value as is ns else # limit output if required substr(s, 1, width) }) rownames(w) <- rownames(x)[seq(i+1, i+step.size)] } # remove header if not required if( !header && head.on ){ colnames(x) <- sapply(colnames(x), function(c) paste(rep(' ', nchar(c)), collapse='')) head.on <- FALSE } # return the content w } cat( show(what2show) ) i <- i + step.size # early break if necessary if( i >= n ) break # ask user what to to next ans <- scan(what='character', quiet=TRUE, n=1, multi.line=FALSE) # process user command if any (otherwise carry on) if( length(ans) > 0 ){ if( !is.na(s <- toNumeric(ans)) ) # change step size step.size <- s else if( !header && ans %in% c('h', 'head') ){ colnames(x) <- head.init head.on <- TRUE } else if( ans %in% c('q', 'quit') ) # quit break } } invisible() } #' Randomizing Data #' #' \code{randomize} permutates independently the entries in each column #' of a matrix-like object, to produce random data that can be used #' in permutation tests or bootstrap analysis. #' #' In the context of NMF, it may be used to generate random data, whose #' factorization serves as a reference for selecting a factorization rank, #' that does not overfit the data. #' #' @param x data to be permutated. It must be an object suitable to be #' passed to the function \code{\link{apply}}. #' @param ... extra arguments passed to the function \code{\link{sample}}. #' #' @return a matrix #' #' @export #' @examples #' x <- matrix(1:32, 4, 8) #' randomize(x) #' randomize(x) #' randomize <- function(x, ...){ if( is(x, 'ExpressionSet') ) x <- Biobase::exprs(x) # resample the columns apply(x, 2, function(c, ...) sample(c, size=length(c), ...), ...) } ###% Returns the rank-k truncated SVD approximation of x tsvd <- function(x, r, ...){ stopifnot( r > 0 && r <= min(dim(x))) s <- svd(x, nu=r, nv=r, ...) s$d <- s$d[1:r] # return results s } ###% Subset a list leaving only the arguments from a given function .extract.args <- function(x, fun, ...){ fdef <- if( is.character(fun) ) getFunction(fun, ...) else if( is.function(fun) ) fun else stop("invalid argument 'fun': expected function name or definition") if( length(x) == 0 ) return(x) x.ind <- charmatch(if( is.list(x) ) names(x) else x, args <- formalArgs(fdef)) x[!is.na(x.ind)] } ###% Returns the version of the package nmfInfo <- function(command){ pkg <- 'NMF' curWarn <- getOption("warn") on.exit(options(warn = curWarn), add = TRUE) options(warn = -1) desc <- packageDescription(pkg, fields="Version") if (is.na(desc)) stop(paste("Package", pkg, "not found")) desc } ###% Returns TRUE if running under Mac OS X + GUI is.Mac <- function(check.gui=FALSE){ is.mac <- (length(grep("darwin", R.version$platform)) > 0) # return TRUE is running on Mac (adn optionally through GUI) is.mac && (!check.gui || .Platform$GUI == 'AQUA') } ###% Hash a function body (using digest) #' @import digest hash_function <- function(f){ b <- body(f) attributes(b) <- NULL fdef <- paste(c(capture.output(args(f))[1], capture.output(print(b))), collapse="\n") # print(fdef) digest(b) } ###% compare function with copy and with no copy cmp.cp <- function(...){ res <- nmf(..., copy=F) resc <- nmf(..., copy=T) cat("identical: ", identical(fit(res), fit(resc)) , " - all.equal: ", all.equal(fit(res), fit(resc)) , " - diff: ", all.equal(fit(res), fit(resc), tol=0) , "\n" ) invisible(res) } # return the internal pointer address C.ptr <- function(x, rec=FALSE) { attribs <- attributes(x) if( !rec || is.null(attribs) ) .Call("ptr_address", x, PACKAGE='NMF') else c( C.ptr(x), sapply(attribs, C.ptr, rec=TRUE)) } is.same <- function(x, y){ C.ptr(x) == C.ptr(y) } is.eset <- function(x) is(x, 'ExpressionSet') # clone an object clone <- function(x){ .Call('clone_object', x, PACKAGE='NMF') } # deep-clone an object clone2 <- function(x){ if( is.environment(x) ){ y <- Biobase::copyEnv(x) eapply(ls(x, all.names=TRUE), function(n){ if( is.environment(x[[n]]) ){ y[[n]] <<- clone(x[[n]]) if( identical(parent.env(x[[n]]), x) ) parent.env(y[[n]]) <<- y } }) }else{ y <- .Call('clone_object', x, PACKAGE='NMF') if( isS4(x) ){ ## deep copy R object lapply(slotNames(class(y)), function(n){ slot(y, n) <<- clone(slot(x, n)) }) }else if( is.list(x) ){ ## copy list or vector sapply(seq_along(x), function(i){ y[[i]] <<- clone(x[[i]]) }) } } y } #compute RSS with C function .rss <- function(x, y) { .Call("Euclidean_rss", x, y, PACKAGE='NMF') } #compute KL divergence with C function .KL <- function(x, y) { .Call("KL_divergence", x, y, PACKAGE='NMF') } #' Updating Objects In Place #' #' These functions modify objects (mainly matrix objects) in place, i.e. they #' act directly on the C pointer. #' Due to their side-effect, they are not meant to be called by the end-user. #' #' \code{pmax.inplace} is a version of \code{\link{pmax}} that updates its first #' argument. #' #' @param x an object to update in place. #' @param lim lower threshold value #' @param skip indexes to skip #' #' @export #' @rdname inplace #' @keywords internal pmax.inplace <- function(x, lim, skip=NULL){ .Call('ptr_pmax', x, lim, as.integer(skip), PACKAGE='NMF') } # colMin colMin <- function(x){ .Call('colMin', x, PACKAGE='NMF') } # colMax colMax <- function(x){ .Call('colMax', x, PACKAGE='NMF') } #' \code{neq.constraints.inplace} apply unequality constraints in place. #' #' @param constraints constraint specification. #' @param ratio fixed ratio on which the constraint applies. #' @param value fixed value to enforce. #' @param copy a logical that indicates if \code{x} should be updated in place #' or not. #' #' @export #' @rdname inplace neq.constraints.inplace <- function(x, constraints, ratio=NULL, value=NULL, copy=FALSE){ # if requested: clone data as neq.constrains.inplace modify the input data in place if( copy ) x <- clone(x) .Call('ptr_neq_constraints', x, constraints, ratio, value, PACKAGE='NMF') } # Test if an external pointer is nil # Taken from package bigmemory ptr_isnil <- function (address) { if (class(address) != "externalptr") stop("address is not an externalptr.") .Call("ptr_isnil", address, PACKAGE='NMF') } ###% Draw the palette of colors ###% ###% Taken from the examples of colorspace::rainbow_hcl ###% pal <- function(col, h=1, border = "light gray") { n <- length(col) plot(0, 0, type="n", xlim = c(0, 1), ylim = c(0, h), axes = FALSE, xlab = "", ylab = "") rect(0:(n-1)/n, 0, 1:n/n, h, col = col, border = border) } ###% Draw the Palette of Colors as a Wheel ###% ###% Taken from the examples of colorspace::rainbow_hcl ###% wheel <- function(col, radius = 1, ...) pie(rep(1, length(col)), col = col, radius = radius, ...) # Define a S4 class to handle function slots given as either a function definition # or a character string that gives the function's name. setClassUnion('.functionSlot', c('character', 'function')) # Define a S4 class to handle function slots given as either a function definition # or a character string that gives the function's name or NULL. setClassUnion('.functionSlotNULL', c('character', 'function', 'NULL')) .validFunctionSlot <- function(slot, allow.empty=FALSE, allow.null=TRUE){ if( is.null(slot) ){ if( !allow.null ) return('NULL value is not allowed') return(TRUE) } if( is.character(slot) ){ if( !allow.empty && slot == '' ) return('character string cannot be empty') if( length(slot) != 1 ) return(paste('character string must be a single value [length =', length(slot), ']', sep='')) } return(TRUE) } ####% Utility function needed in heatmap.plus.2 #invalid <- function (x) #{ # if (missing(x) || is.null(x) || length(x) == 0) # return(TRUE) # if (is.list(x)) # return(all(sapply(x, invalid))) # else if (is.vector(x)) # return(all(is.na(x))) # else return(FALSE) #} # ####% Modification of the function heatmap.2 including a small part of function ####% heatmap.plus to allow extra annotation rows #heatmap.plus.2 <- # function (x, Rowv = TRUE, Colv = if (symm) "Rowv" else TRUE, # distfun = dist, hclustfun = hclust, dendrogram = c("both", # "row", "column", "none"), symm = FALSE, scale = c("none", # "row", "column"), na.rm = TRUE, revC = identical(Colv, # "Rowv"), add.expr, breaks, symbreaks = min(x < 0, na.rm = TRUE) || # scale != "none", col = "heat.colors", colsep, rowsep, # sepcolor = "white", sepwidth = c(0.05, 0.05), cellnote, notecex = 1, # notecol = "cyan", na.color = par("bg"), trace = c("column", # "row", "both", "none"), tracecol = "cyan", hline = median(breaks), # vline = median(breaks), linecol = tracecol, margins = c(5, # 5), ColSideColors, RowSideColors, cexRow = 0.2 + 1/log10(nr), # cexCol = 0.2 + 1/log10(nc), labRow = NULL, labCol = NULL, # key = TRUE, keysize = 1.5, density.info = c("histogram", # "density", "none"), denscol = tracecol, symkey = min(x < # 0, na.rm = TRUE) || symbreaks, densadj = 0.25, main = NULL, # xlab = NULL, ylab = NULL, lmat = NULL, lhei = NULL, lwid = NULL, # ...) #{ # scale01 <- function(x, low = min(x), high = max(x)) { # x <- (x - low)/(high - low) # x # } # retval <- list() # scale <- if (symm && missing(scale)) # "none" # else match.arg(scale) # dendrogram <- match.arg(dendrogram) # trace <- match.arg(trace) # density.info <- match.arg(density.info) # if (length(col) == 1 && is.character(col)) # col <- get(col, mode = "function") # if (!missing(breaks) && (scale != "none")) # warning("Using scale=\"row\" or scale=\"column\" when breaks are", # "specified can produce unpredictable results.", "Please consider using only one or the other.") # if (is.null(Rowv) || is.na(Rowv)) # Rowv <- FALSE # if (is.null(Colv) || is.na(Colv)) # Colv <- FALSE # else if (Colv == "Rowv" && !isTRUE(Rowv)) # Colv <- FALSE # if (length(di <- dim(x)) != 2 || !is.numeric(x)) # stop("`x' must be a numeric matrix") # nr <- di[1] # nc <- di[2] # if (nr <= 1 || nc <= 1) # stop("`x' must have at least 2 rows and 2 columns") # if (!is.numeric(margins) || length(margins) != 2) # stop("`margins' must be a numeric vector of length 2") # if (missing(cellnote)) # cellnote <- matrix("", ncol = ncol(x), nrow = nrow(x)) # if (!inherits(Rowv, "dendrogram")) { # if (((!isTRUE(Rowv)) || (is.null(Rowv))) && (dendrogram %in% # c("both", "row"))) { # if (is.logical(Colv) && (Colv)) # dendrogram <- "column" # else dedrogram <- "none" # warning("Discrepancy: Rowv is FALSE, while dendrogram is `", # dendrogram, "'. Omitting row dendogram.") # } # } # if (!inherits(Colv, "dendrogram")) { # if (((!isTRUE(Colv)) || (is.null(Colv))) && (dendrogram %in% # c("both", "column"))) { # if (is.logical(Rowv) && (Rowv)) # dendrogram <- "row" # else dendrogram <- "none" # warning("Discrepancy: Colv is FALSE, while dendrogram is `", # dendrogram, "'. Omitting column dendogram.") # } # } # if (inherits(Rowv, "dendrogram")) { # ddr <- Rowv # rowInd <- order.dendrogram(ddr) # } # else if (is.integer(Rowv)) { # hcr <- hclustfun(distfun(x)) # ddr <- as.dendrogram(hcr) # ddr <- reorder(ddr, Rowv) # rowInd <- order.dendrogram(ddr) # if (nr != length(rowInd)) # stop("row dendrogram ordering gave index of wrong length") # } # else if (isTRUE(Rowv)) { # Rowv <- rowMeans(x, na.rm = na.rm) # hcr <- hclustfun(distfun(x)) # ddr <- as.dendrogram(hcr) # ddr <- reorder(ddr, Rowv) # rowInd <- order.dendrogram(ddr) # if (nr != length(rowInd)) # stop("row dendrogram ordering gave index of wrong length") # } # else { # rowInd <- nr:1 # } # if (inherits(Colv, "dendrogram")) { # ddc <- Colv # colInd <- order.dendrogram(ddc) # } # else if (identical(Colv, "Rowv")) { # if (nr != nc) # stop("Colv = \"Rowv\" but nrow(x) != ncol(x)") # if (exists("ddr")) { # ddc <- ddr # colInd <- order.dendrogram(ddc) # } # else colInd <- rowInd # } # else if (is.integer(Colv)) { # hcc <- hclustfun(distfun(if (symm) # x # else t(x))) # ddc <- as.dendrogram(hcc) # ddc <- reorder(ddc, Colv) # colInd <- order.dendrogram(ddc) # if (nc != length(colInd)) # stop("column dendrogram ordering gave index of wrong length") # } # else if (isTRUE(Colv)) { # Colv <- colMeans(x, na.rm = na.rm) # hcc <- hclustfun(distfun(if (symm) # x # else t(x))) # ddc <- as.dendrogram(hcc) # ddc <- reorder(ddc, Colv) # colInd <- order.dendrogram(ddc) # if (nc != length(colInd)) # stop("column dendrogram ordering gave index of wrong length") # } # else { # colInd <- 1:nc # } # retval$rowInd <- rowInd # retval$colInd <- colInd # retval$call <- match.call() # x <- x[rowInd, colInd] # x.unscaled <- x # cellnote <- cellnote[rowInd, colInd] # if (is.null(labRow)) # labRow <- if (is.null(rownames(x))) # (1:nr)[rowInd] # else rownames(x) # else labRow <- labRow[rowInd] # if (is.null(labCol)) # labCol <- if (is.null(colnames(x))) # (1:nc)[colInd] # else colnames(x) # else labCol <- labCol[colInd] # if (scale == "row") { # retval$rowMeans <- rm <- rowMeans(x, na.rm = na.rm) # x <- sweep(x, 1, rm) # retval$rowSDs <- sx <- apply(x, 1, sd, na.rm = na.rm) # x <- sweep(x, 1, sx, "/") # } # else if (scale == "column") { # retval$colMeans <- rm <- colMeans(x, na.rm = na.rm) # x <- sweep(x, 2, rm) # retval$colSDs <- sx <- apply(x, 2, sd, na.rm = na.rm) # x <- sweep(x, 2, sx, "/") # } # if (missing(breaks) || is.null(breaks) || length(breaks) < # 1) { # if (missing(col) || is.function(col)) # breaks <- 16 # else breaks <- length(col) + 1 # } # if (length(breaks) == 1) { # if (!symbreaks) # breaks <- seq(min(x, na.rm = na.rm), max(x, na.rm = na.rm), # length = breaks) # else { # extreme <- max(abs(x), na.rm = TRUE) # breaks <- seq(-extreme, extreme, length = breaks) # } # } # nbr <- length(breaks) # ncol <- length(breaks) - 1 # if (class(col) == "function") # col <- col(ncol) # min.breaks <- min(breaks) # max.breaks <- max(breaks) # x[x < min.breaks] <- min.breaks # x[x > max.breaks] <- max.breaks # if (missing(lhei) || is.null(lhei)) # lhei <- c(keysize, 4) # if (missing(lwid) || is.null(lwid)) # lwid <- c(keysize, 4) # if (missing(lmat) || is.null(lmat)) { # lmat <- rbind(4:3, 2:1) # # # hack for adding extra annotations # if (!missing(ColSideColors)) { # if (!is.matrix(ColSideColors)) # stop("'ColSideColors' must be a matrix") # # if (!is.character(ColSideColors) || dim(ColSideColors)[1] != # nc) # stop("'ColSideColors' must be a character vector/matrix with length/ncol = ncol(x)") # lmat <- rbind(lmat[1, ] + 1, c(NA, 1), lmat[2, ] + 1) # lhei <- c(lhei[1], 0.2, lhei[2]) # } # if (!missing(RowSideColors)) { # if (!is.character(RowSideColors) || length(RowSideColors) != # nr) # stop("'RowSideColors' must be a character vector of length nrow(x)") # lmat <- cbind(lmat[, 1] + 1, c(rep(NA, nrow(lmat) - # 1), 1), lmat[, 2] + 1) # lwid <- c(lwid[1], 0.2, lwid[2]) # } # lmat[is.na(lmat)] <- 0 # } # if (length(lhei) != nrow(lmat)) # stop("lhei must have length = nrow(lmat) = ", nrow(lmat)) # if (length(lwid) != ncol(lmat)) # stop("lwid must have length = ncol(lmat) =", ncol(lmat)) # op <- par(no.readonly = TRUE) # on.exit(par(op)) # layout(lmat, widths = lwid, heights = lhei, respect = FALSE) # if (!missing(RowSideColors)) { # par(mar = c(margins[1], 0, 0, 0.5)) # image(rbind(1:nr), col = RowSideColors[rowInd], axes = FALSE) # } # if (!missing(ColSideColors)) { # par(mar = c(0.5, 0, 0, margins[2])) # csc = ColSideColors[colInd, ] # csc.colors = matrix() # csc.names = names(table(csc)) # csc.i = 1 # for (csc.name in csc.names) { # csc.colors[csc.i] = csc.name # csc[csc == csc.name] = csc.i # csc.i = csc.i + 1 # } # csc = matrix(as.numeric(csc), nrow = dim(csc)[1]) # image(csc, col = as.vector(csc.colors), axes = FALSE) # if (length(colnames(ColSideColors)) > 0) { # axis(2, 0:(dim(csc)[2] - 1)/(dim(csc)[2] - 1), colnames(ColSideColors), # las = 2, tick = FALSE, cex.axis= cexRow) # } # } # par(mar = c(margins[1], 0, 0, margins[2])) # if (!symm || scale != "none") { # x <- t(x) # cellnote <- t(cellnote) # } # if (revC) { # iy <- nr:1 # if (exists("ddr")) # ddr <- rev(ddr) # x <- x[, iy] # cellnote <- cellnote[, iy] # } # else iy <- 1:nr # image(1:nc, 1:nr, x, xlim = 0.5 + c(0, nc), ylim = 0.5 + # c(0, nr), axes = FALSE, xlab = "", ylab = "", col = col, # breaks = breaks, ...) # retval$carpet <- x # if (exists("ddr")) # retval$rowDendrogram <- ddr # if (exists("ddc")) # retval$colDendrogram <- ddc # retval$breaks <- breaks # retval$col <- col # if (!invalid(na.color) & any(is.na(x))) { # mmat <- ifelse(is.na(x), 1, NA) # image(1:nc, 1:nr, mmat, axes = FALSE, xlab = "", ylab = "", # col = na.color, add = TRUE) # } # axis(1, 1:nc, labels = labCol, las = 2, line = -0.5, tick = 0, # cex.axis = cexCol) # if (!is.null(xlab)) # mtext(xlab, side = 1, line = margins[1] - 1.25) # axis(4, iy, labels = labRow, las = 2, line = -0.5, tick = 0, # cex.axis = cexRow) # if (!is.null(ylab)) # mtext(ylab, side = 4, line = margins[2] - 1.25) # if (!missing(add.expr)) # eval(substitute(add.expr)) # if (!missing(colsep)) # for (csep in colsep) rect(xleft = csep + 0.5, ybottom = rep(0, # length(csep)), xright = csep + 0.5 + sepwidth[1], # ytop = rep(ncol(x) + 1, csep), lty = 1, lwd = 1, # col = sepcolor, border = sepcolor) # if (!missing(rowsep)) # for (rsep in rowsep) rect(xleft = 0, ybottom = (ncol(x) + # 1 - rsep) - 0.5, xright = nrow(x) + 1, ytop = (ncol(x) + # 1 - rsep) - 0.5 - sepwidth[2], lty = 1, lwd = 1, # col = sepcolor, border = sepcolor) # min.scale <- min(breaks) # max.scale <- max(breaks) # x.scaled <- scale01(t(x), min.scale, max.scale) # if (trace %in% c("both", "column")) { # retval$vline <- vline # vline.vals <- scale01(vline, min.scale, max.scale) # for (i in colInd) { # if (!is.null(vline)) { # abline(v = i - 0.5 + vline.vals, col = linecol, # lty = 2) # } # xv <- rep(i, nrow(x.scaled)) + x.scaled[, i] - 0.5 # xv <- c(xv[1], xv) # yv <- 1:length(xv) - 0.5 # lines(x = xv, y = yv, lwd = 1, col = tracecol, type = "s") # } # } # if (trace %in% c("both", "row")) { # retval$hline <- hline # hline.vals <- scale01(hline, min.scale, max.scale) # for (i in rowInd) { # if (!is.null(hline)) { # abline(h = i + hline, col = linecol, lty = 2) # } # yv <- rep(i, ncol(x.scaled)) + x.scaled[i, ] - 0.5 # yv <- rev(c(yv[1], yv)) # xv <- length(yv):1 - 0.5 # lines(x = xv, y = yv, lwd = 1, col = tracecol, type = "s") # } # } # if (!missing(cellnote)) # text(x = c(row(cellnote)), y = c(col(cellnote)), labels = c(cellnote), # col = notecol, cex = notecex) # par(mar = c(margins[1], 0, 0, 0)) # if (dendrogram %in% c("both", "row")) { # plot(ddr, horiz = TRUE, axes = FALSE, yaxs = "i", leaflab = "none") # } # else plot.new() # par(mar = c(0, 0, if (!is.null(main)) 5 else 0, margins[2])) # if (dendrogram %in% c("both", "column")) { # plot(ddc, axes = FALSE, xaxs = "i", leaflab = "none") # } # else plot.new() # if (!is.null(main)) # title(main, cex.main = 1.5 * op[["cex.main"]]) # if (key) { # par(mar = c(5, 4, 2, 1), cex = 0.75) # tmpbreaks <- breaks # if (symkey) { # max.raw <- max(abs(c(x, breaks)), na.rm = TRUE) # min.raw <- -max.raw # tmpbreaks[1] <- -max(abs(x)) # tmpbreaks[length(tmpbreaks)] <- max(abs(x)) # } # else { # min.raw <- min(x, na.rm = TRUE) # max.raw <- max(x, na.rm = TRUE) # } # z <- seq(min.raw, max.raw, length = length(col)) # image(z = matrix(z, ncol = 1), col = col, breaks = tmpbreaks, # xaxt = "n", yaxt = "n") # par(usr = c(0, 1, 0, 1)) # lv <- pretty(breaks) # xv <- scale01(as.numeric(lv), min.raw, max.raw) # axis(1, at = xv, labels = lv) # if (scale == "row") # mtext(side = 1, "Row Z-Score", line = 2) # else if (scale == "column") # mtext(side = 1, "Column Z-Score", line = 2) # else mtext(side = 1, "Value", line = 2) # if (density.info == "density") { # dens <- density(x, adjust = densadj, na.rm = TRUE) # omit <- dens$x < min(breaks) | dens$x > max(breaks) # dens$x <- dens$x[-omit] # dens$y <- dens$y[-omit] # dens$x <- scale01(dens$x, min.raw, max.raw) # lines(dens$x, dens$y/max(dens$y) * 0.95, col = denscol, # lwd = 1) # axis(2, at = pretty(dens$y)/max(dens$y) * 0.95, pretty(dens$y)) # title("Color Key\nand Density Plot") # par(cex = 0.5) # mtext(side = 2, "Density", line = 2) # } # else if (density.info == "histogram") { # h <- hist(x, plot = FALSE, breaks = breaks) # hx <- scale01(breaks, min.raw, max.raw) # hy <- c(h$counts, h$counts[length(h$counts)]) # lines(hx, hy/max(hy) * 0.95, lwd = 1, type = "s", # col = denscol) # axis(2, at = pretty(hy)/max(hy) * 0.95, pretty(hy)) # title("Color Key\nand Histogram") # par(cex = 0.5) # mtext(side = 2, "Count", line = 2) # } # else title("Color Key") # } # else plot.new() # retval$colorTable <- data.frame(low = retval$breaks[-length(retval$breaks)], # high = retval$breaks[-1], color = retval$col) # invisible(retval) #} # Extracted from the psychometric package (0.1.0) # Copyright Thomas D. Fletcher # Under Gnu GPL2 CI.Rsqlm <- function (obj, level = 0.95) { l <- level rsq <- summary(obj)$r.squared k <- summary(obj)$df[1] - 1 n <- obj$df + k + 1 mat <- CI.Rsq(rsq, n, k, level = l) return(mat) } # Extracted from the psychometric package (0.1.0) # Copyright Thomas D. Fletcher # Under Gnu GPL2 CI.Rsq <- function (rsq, n, k, level = 0.95) { noma <- 1 - level sersq <- sqrt((4 * rsq * (1 - rsq)^2 * (n - k - 1)^2)/((n^2 - 1) * (n + 3))) zs <- -qnorm(noma/2) mez <- zs * sersq lcl <- rsq - mez ucl <- rsq + mez mat <- data.frame(Rsq = rsq, SErsq = sersq, LCL = lcl, UCL = ucl) return(mat) } str_dim <- function(x, dims=dim(x)){ if( !is.null(dims) ) paste0(dims, collapse = ' x ') else length(x) } # Internal override stringr function str_match # # This is to get the previous behaviour on optional groups, because # in stringr >= 1.0.0 absent optional groups get an NA value instead # of an empty string, which in turn breaks some downstream processing. str_match <- function(...){ res <- stringr::str_match(...) # replace NAs by "" for globally matched strings if( length(w <- which(!is.na(res[, 1L]))) ){ res[w, ][is.na(res[w, ])] <- "" } res } NMF/R/NMFStrategy-class.R0000644000176000001440000003325212305630424014520 0ustar ripleyusers# S4 class for NMG algorithms # # Author: Renaud Gaujoux ############################################################################### #' @include algorithmic.R #' @include NMFSet-class.R NULL #' Generic Strategy Class #' #' This class defines a common interface for generic algorithm strategies #' (e.g., \code{\linkS4class{NMFStrategy}}). #' #' @slot name character string giving the name of the algorithm #' @slot package name of the package that defined the strategy. #' @slot defaults default values for some of the algorithm's arguments. #' #' @keywords internal setClass('Strategy' , contains = 'VIRTUAL' , representation = representation( name = 'character' # the strategy name , package = 'character' # the package that defines the strategy , defaults = 'list' ) , prototype = prototype( package = character() , name = character() ) , validity=function(object){ # slot 'name' must be a non-empty character string obj <- name(object) if( !length(obj) || (length(obj)>1L || obj=='') ) return(str_c("Slot 'name' must be a single non-empty character string [", obj, ']')) TRUE } ) #' Accessing Strategy Names #' #' \code{name} and \code{name<-} gets and sets the name associated with an object. #' In the case of \code{Strategy} objects it is the the name of the algorithm. #' #' @param object an R object with a defined \code{name} method #' @param ... extra arguments to allow extension #' @param value replacement value #' #' @export #' @inline #' @rdname Strategy-class setGeneric('name', function(object, ...) standardGeneric('name')) #' Returns the name of an algorithm #' @param all a logical that indicates if all the names associated with a strategy #' should be returned (\code{TRUE}), or only the first (primary) one (\code{FALSE}). setMethod('name', signature(object='Strategy'), function(object, all=FALSE){ n <- slot(object, 'name') if( length(n) && !all ) n[1L] else n } ) #' @export #' @inline #' @rdname Strategy-class setGeneric('name<-', function(object, ..., value) standardGeneric('name<-')) #' Sets the name(s) of an NMF algorithm setReplaceMethod('name', signature(object='Strategy', value='character'), function(object, value){ slot(object, 'name') <- value validObject(object) object } ) defaultArgument <- function(name, object, value, force=FALSE){ # taken from methods::hasArg aname <- as.character(substitute(name)) miss <- eval(substitute(missing(name)), sys.frame(sys.parent())) defaults <- attr(object, 'defaults') if( !miss && !force ) eval(substitute(name), sys.frame(sys.parent())) else if( aname %in% names(defaults) ) defaults[[aname]] else value } #' Virtual Interface for NMF Algorithms #' #' This class partially implements the generic interface defined for general #' algorithms defined in the \pkg{NMF} package (see \code{\link{algorithmic-NMF}}). #' #' @slot objective the objective function associated with the algorithm (Frobenius, Kullback-Leibler, etc...). #' It is either an access key of a registered objective function or a function definition. #' In the latter case, the given function must have the following signature \code{(x="NMF", y="matrix")} #' and return a nonnegative real value. #' #' @slot model a character string giving either the (sub)class name of the NMF-class instance used #' and returned by the strategy, or a function name. #' #' @slot mixed a logical that indicates if the algorithm works on mixed-sign data. #' #' @keywords internal setClass('NMFStrategy' , representation( objective = '.functionSlot' # the objective function used to compute the error (defined by name or function) , model = 'character' # NMF model to use , mixed = 'logical' # can the input data be negative? ) , prototype=prototype(objective='euclidean', model='NMFstd', mixed=FALSE) , validity=function(object){ # slot 'objective' must either be a non-empty character string or a function obj <- objective(object) if( is.character(obj) && obj == '' ) return("Slot 'objective' must either be a non-empty character string or a function definition.") # slot 'model' must be the name of a class that extends class 'NMF' obj <- modelname(object) if( !is.character(obj) ) return("Slot 'model' must be a character vector") if( any(inv <- !sapply(obj, isNMFclass)) ) return(paste("Slot 'model' must contain only names of a class that extends class 'NMF' [failure on class(es) " , paste( paste("'", obj[inv], "'", sep=''), collapse=', ') ,"]" , sep='')) # slot 'mixed' must be a single logical obj <- slot(object, 'mixed') if( length(obj) != 1 ) return( paste("Slot 'mixed' must be a single logical [length=", length(obj), "]", sep='') ) } , contains = c('VIRTUAL', 'Strategy') ) #' @export #' @rdname NMFStrategy-class setMethod('show', 'NMFStrategy', function(object){ cat('\n", sep='') cat(" name: ", name(object), " [", packageSlot(object), "]\n", sep='') svalue <- objective(object) svalue <- if( is.function(svalue) ) str_args(svalue, exdent=10) else paste("'", svalue,"'", sep='') cat(" objective:", svalue, "\n") cat(" model:", modelname(object), "\n") if( length(object@defaults) > 0L ){ cat(" defaults:", str_desc(object@defaults, exdent=10L), "\n") } return(invisible()) } ) # Coerce method for 'NMFStrategy' objects into 'character': give the main name setAs('NMFStrategy', 'character' , def = function(from) name(from) ) #' Factory Method for NMFStrategy Objects #' #' Creates NMFStrategy objects that wraps implementation of NMF algorithms into #' a unified interface. #' #' @param name name/key of an NMF algorithm. #' @param method definition of the algorithm #' @param ... extra arguments passed to \code{\link{new}}. #' #' @export #' @inline setGeneric('NMFStrategy', function(name, method, ...) standardGeneric('NMFStrategy') ) #' Creates an \code{NMFStrategyFunction} object that wraps the function \code{method} #' into a unified interface. #' #' \code{method} must be a function with signature \code{(y="matrix", x="NMFfit", ...)}, #' and return an object of class \code{\linkS4class{NMFfit}}. setMethod('NMFStrategy', signature(name='character', method='function'), function(name, method, ...){ # build a NMFStrategyFunction object on the fly to wrap function 'method' NMFStrategy(name=name, algorithm=method, ...) } ) #' Creates an \code{NMFStrategy} object based on a template object (Constructor-Copy). setMethod('NMFStrategy', signature(name='character', method='NMFStrategy'), function(name, method, ...){ package <- topns_name() # build an NMFStrategy object based on template object strategy <- new(class(method), method, name=name, ..., package=package) # valid the new strategy validObject(strategy) # add trace of inheritance from parent NMF algorithm attr(strategy, 'parent') <- name(method)[1] # return new object strategy } ) #' Creates an \code{NMFStrategy} based on a template object (Constructor-Copy), #' in particular it uses the \strong{same} name. setMethod('NMFStrategy', signature(name='NMFStrategy', method='missing'), function(name, method, ...){ # do not change the object if single argument if( nargs() == 1L ) return(name) # use the name as a key # NB: need special trick to avoid conflict between argument and function mname <- match.fun('name')(name) NMFStrategy(name=mname, method=name, ...) } ) #' Creates an \code{NMFStrategy} based on a registered NMF algorithm that is used #' as a template (Constructor-Copy), in particular it uses the \strong{same} name. #' #' It is a shortcut for \code{NMFStrategy(nmfAlgorithm(method, exact=TRUE), ...)}. setMethod('NMFStrategy', signature(name='missing', method='character'), function(name, method, ...){ NMFStrategy(nmfAlgorithm(method, exact=TRUE), ...) } ) #' Creates an \code{NMFStrategy} based on a template object (Constructor-Copy) #' but using a randomly generated name. setMethod('NMFStrategy', signature(name='NULL', method='NMFStrategy'), function(name, method, ...){ # use the name as a key # NB: need special trick to avoid conflict between argument and function mname <- match.fun('name')(method) mname <- basename(tempfile(str_c(mname, '_'))) NMFStrategy(name=mname, method=method, ...) } ) #' Creates an \code{NMFStrategy} based on a registered NMF algorithm that is used #' as a template. setMethod('NMFStrategy', signature(name='character', method='character'), function(name, method, ...){ NMFStrategy(name=name, method=nmfAlgorithm(method, exact=TRUE), ...) } ) #' Creates an \code{NMFStrategy} based on a registered NMF algorithm (Constructor-Copy) #' using a randomly generated name. #' #' It is a shortcut for \code{NMFStrategy(NULL, nmfAlgorithm(method), ...)}. setMethod('NMFStrategy', signature(name='NULL', method='character'), function(name, method, ...){ NMFStrategy(NULL, method=nmfAlgorithm(method, exact=TRUE), ...) } ) #' Creates an NMFStrategy, determining its type from the extra arguments passed #' in \code{...}: if there is an argument named \code{Update} then an #' \code{NMFStrategyIterative} is created, or if there is an argument #' named \code{algorithm} then an \code{NMFStrategyFunction} is created. #' Calls other than these generates an error. #' setMethod('NMFStrategy', signature(name='character', method='missing'), function(name, method, ...){ package <- topns_name() # check iterative strategy if( hasArg2('Update') ){ # create a new NMFStrategyIterative object new('NMFStrategyIterative', name=name, ..., package=package) }else if( hasArg2('mcode') ){ new('NMFStrategyOctave', name=name, ..., package=package) }else if( hasArg2('algorithm') ){ new('NMFStrategyFunction', name=name, ..., package=package) }else{ stop('NMFStrategy - Could not infer the type of NMF strategy to instantiate.') } } ) #' Pure virtual method defined for all NMF algorithms to ensure #' that a method \code{run} is defined by sub-classes of \code{NMFStrategy}. #' #' It throws an error if called directly. #' @rdname NMFStrategy setMethod('run', signature(object='NMFStrategy', y='matrix', x='NMFfit'), function(object, y, x, ...){ stop("NMFStrategy::run is a pure virtual method that should be overloaded in class '", class(object),"'.") } ) #' Method to run an NMF algorithm directly starting from a given NMF model. #' @rdname NMFStrategy setMethod('run', signature(object='NMFStrategy', y='matrix', x='NMF'), function(object, y, x, ...){ run(object, y, NMFfit(fit=x, seed='none', method=name(object)), ...) } ) #' Computes the value of the objective function between the estimate \code{x} #' and the target \code{y}. #' #' @param x an NMF model that estimates \code{y}. #' #' @inline setMethod('deviance', 'NMFStrategy', function(object, x, y, ...){ obj.fun <- slot(object, 'objective') # return the distance computed using the strategy's objective function if( !is.function(obj.fun) ) deviance(x, y, method=obj.fun, ...) else # directly compute the objective function obj.fun(x, y, ...) } ) #' Gets the objective function associated with an NMF algorithm. #' #' It is used in \code{\link[=deviance,NMFStrategy-method]{deviance}} #' to compute the objective value for an NMF model with respect to #' a given target matrix. #' #' @export #' @rdname NMFStrategy-class setMethod('objective', 'NMFStrategy', function(object){ slot(object, 'objective') } ) #' Sets the objective function associated with an NMF algorithm, with a character string #' that must be a registered objective function. #' @export #' @rdname NMFStrategy-class setReplaceMethod('objective', signature(object='NMFStrategy', value='character'), function(object, value){ #TODO: test for the existence of objective method slot(object, 'objective') <- value validObject(object) object } ) #' Sets the objective function associated with an NMF algorithm, with a function #' that computes the approximation error between an NMF model and a target matrix. #' @export #' @rdname NMFStrategy-class setReplaceMethod('objective', signature(object='NMFStrategy', value='function'), function(object, value){ slot(object, 'objective') <- value validObject(object) object } ) #' Returns the model(s) that an NMF algorithm can fit. #' #' @examples #' # get the type of model(s) associated with an NMF algorithm #' modelname( nmfAlgorithm('brunet') ) #' modelname( nmfAlgorithm('nsNMF') ) #' modelname( nmfAlgorithm('offset') ) #' setMethod('modelname', signature(object='NMFStrategy'), function(object){ slot(object, 'model') } ) #' \code{is.mixed} tells if an NMF algorithm works on mixed-sign data. #' @export #' @rdname NMFStrategy-class is.mixed <- function(object){ return( slot(object, 'mixed') ) } #' Showing Arguments of NMF Algorithms #' #' This function returns the extra arguments that can be passed #' to a given NMF algorithm in call to \code{\link{nmf}}. #' #' @param x algorithm specification #' @param ... extra argument to allow extension #' #' @export nmfFormals <- function(x, ...){ UseMethod('nmfFormals') } #' @S3method nmfFormals character nmfFormals.character <- function(x, ...){ s <- nmfAlgorithm(x) nmfFormals(s, ...) } #' @S3method nmfFormals NMFStrategy nmfFormals.NMFStrategy <- function(x, ...){ m <- getMethod('run', signature(object='NMFStrategy', y='matrix', x='NMFfit')) args <- allFormals(m) # prepend registered default arguments expand_list(x@defaults, args) } #' \code{nmfArgs} is a shortcut for \code{args(nmfWrapper(x))}, to #' display the arguments of a given NMF algorithm. #' #' @rdname nmfFormals #' @export #' @examples #' #' # show arguments of an NMF algorithm #' nmfArgs('brunet') #' nmfArgs('snmf/r') nmfArgs <- function(x){ args(nmfWrapper(x)) } NMF/R/atracks.R0000644000176000001440000003702612530700355012706 0ustar ripleyusers# Generic framework for handling annotation tracks in plots, specifically in # in heatmaps generated by the function aheatmap. # # Author: Renaud Gaujoux # Creation: 24 Jan 2012 ############################################################################### setOldClass('annotationTrack') #' Annotation Tracks #' #' \code{.atrack} is an S4 generic method that converts an object into #' an annotation track object. #' It provides a general and flexible annotation framework that is used #' by \code{\link{aheatmap}} to annotates heatmap rows and columns. #' #' Methods for \code{.atrack} exist for common type of objects, which #' should provide enough options for new methods to define how annotation #' track are extracted from more complex objects, by coercing/filtering #' them into a supported type. #' #' @param object an object from which is extracted annotation tracks #' @param ... extra arguments to allow extensions and passed to the next method #' call. #' For \code{atrack}, arguments in \code{...} are concatenated into a single #' \code{annotationTrack} object. #' #' @rdname atrack #' @export #' @inline #' @keywords internal setGeneric('.atrack', function(object, ...) standardGeneric('.atrack')) #' \code{is.atrack} tests if an object is an \code{annotationTrack} object. #' #' @param x an R object #' #' @rdname atrack is.atrack <- function(x) is(x, 'annotationTrack') aname <- function(x, name){ return(x) if( missing(name) ){ cn <- colnames(x) an <- attr(x, 'aname') name <- if( !is.null(cn) ) cn else if( !is.null(an) ) an else class(x)[1] attr(x, 'aname') <- name }else{ attr(x, 'aname') <- name x } } #' \code{adata} get/sets the annotation parameters on an object #' #' @param value replacement value for the complete annotation data list #' #' @rdname atrack adata <- function(x, value, ...){ if( missing(value) ){ ad <- attr(x, 'annotationData') if( is.null(ad) ) ad <- list() # either return the annotationData itself or set values and return the object if( nargs() == 1L ) ad else{ ad <- c(list(...), ad) ad <- ad[!duplicated(names(ad))] adata(x, ad) } }else{ if( !is.list(value) ) stop("Annotation data must be a list.") attr(x, 'annotationData') <- value x } } #' \code{amargin} get/sets the annotation margin, i.e. along which dimension of #' the data the annotations are to be considered. #' #' @rdname atrack amargin <- function(x, value){ if( missing(value) ) adata(x)$margin else adata(x, margin=value) } #' \code{anames} returns the reference margin names for annotation tracks, #' from their embedded annotation data object. #' #' @rdname atrack anames <- function(x, default.margin){ if( is.numeric(x) && length(x) == 1L ) NULL else if( is.vector(x) ) names(x) else{ m <- amargin(x) if( is.null(m) && !missing(default.margin) ) m <- default.margin # special case for ExpressionSet objects whose dimnames method returns NULL if( is(x, 'ExpressionSet') ) x <- Biobase::exprs(x) if( !is.null(m) ) dimnames(x)[[m]] else NULL } } #' \code{alength} returns the reference length for annotation tracks, #' from their embedded annotation data object #' #' @param default.margin margin to use if no margin data is stored in the #' \code{x}. #' #' @rdname atrack alength <- function(x, default.margin){ if( is.numeric(x) && length(x) == 1L ) as.integer(x) else if( is.vector(x) ) length(x) else{ m <- amargin(x) if( is.null(m) && !missing(default.margin) ) m <- default.margin if( !is.null(m) ) dim(x)[m] else NULL } } test.match_atrack <- function(){ requireNamespace('RUnit') na <- paste("name_", 1:10, sep='') mat <- as.matrix(setNames(1:10, na)) checkEquals <- RUnit::checkEquals .check <- function(x){ cat(class(x), " [", str_out(x, Inf, use.names=TRUE), "] :\n") y <- match_atrack(x, mat) print(y) checkEquals( class(y), class(x), "Same class as input") checkEquals( length(y), nrow(mat), "Correct length") checkEquals( names(y), rownames(mat), "Correct names") } .test <- function(x){ .check(x) .check(sample(x)) .check(x[1:5]) .check(sample(x)[1:5]) .check(setNames(x, na)) .check(sample(setNames(x, na))) .check(setNames(x, rev(na))) .check(setNames(x, na)[1:5]) .check(setNames(x, na)[3:6]) .check(setNames(x, na)[c(3,2,6)]) x2 <- setNames(c(x[1:5], x[1:3]), c(na[1:5], paste("not_in_", 1:3, sep=''))) .check(x2) } .test(letters[1:10]) .test(1:10) .test(as.numeric(1:10) + 0.5) .test(c(rep(TRUE, 5), rep(FALSE, 5))) .test(factor(gl(2,5,labels=c("A", "B")))) } #' Extending Annotation Vectors #' #' Extends a vector used as an annotation track to match the number of rows #' and the row names of a given data. #' #' @param x annotation vector #' @param data reference data #' @return a vector of the same type as \code{x} #' @export #' match_atrack <- function(x, data=NULL){ if( is.null(data) || length(x) == 0L ) return(x) # reorder and extend if a reference data matrix is provided refnames <- anames(data, default.margin=1L) reflength <- alength(data, default.margin=1L) # if no ref length (=> no refnames either): do nothing if( is.null(reflength) ) return(x) # special handling of character vectors if( is.character(x) && is.null(names(x)) && !is.null(refnames) ){ # if( !any(names(x) %in% refnames) && any(x %in% refnames) ){ if( any(x %in% refnames) ){ vmessage("match_atrack - Annotation track [", str_out(x, 3, use.names=TRUE), "] has some values matching data names: converting into a logical using values as names.") x <- setNames(rep(TRUE, length(x)), x) } } # reorder based on names .hasNames <- FALSE if( !is.null(names(x)) && !is.null(refnames) ){ inref <- names(x) %in% refnames if( !all(inref) ){ vmessage("match_atrack - Annotation track [", str_out(x, 3, use.names=TRUE), "] has partially matching names: subsetting track to match data") x <- x[inref] if( length(x) == 0L ) vmessage("match_atrack - Subset annotation track is empty") }else vmessage("match_atrack - Annotation track [", str_out(x, 3, use.names=TRUE), "] using names as identifiers") .hasNames <- TRUE if( anyDuplicated(names(x)) ){ dups <- duplicated(names(x)) vmessage("match_atrack - Annotation track [", str_out(x, 3, use.names=TRUE), "]: removing duplicated names [", str_out(x[dups], 3, use.names=TRUE),"]") x <- x[!dups] } } lx <- length(x) if( lx > reflength ){ stop("match_atrack - Invalid annotation track [", str_out(x, 3, use.names=TRUE), "]: more elements [", lx, "] than rows in data [", reflength, "].") } if( lx == reflength ){ # reorder if necessary res <- if( !.hasNames ) x else x[match(refnames, names(x))] return(res) } # build similar vector of correct size res <- if( is.factor(x) ) setNames(factor(c(x, rep(NA, reflength-lx)), levels=c(levels(x), NA)), refnames) else setNames(c(x, rep(NA, reflength-lx)), refnames) res[1:lx] <- NA # if not using names if( !.hasNames ){ if( is.integer(x) ) res[x] <- x else res[1:lx] <- x }else{ # put the values of x at the write place res[match(names(x), refnames)] <- x } res } #' The default method converts character or integer vectors into factors. #' Numeric vectors, factors, a single NA or \code{annotationTrack} objects are #' returned unchanged (except from reordering by argument \code{order}). #' Data frames are not changed either, but class 'annotationTrack' is appended #' to their original class set. #' #' @param data object used to extend the annotation track within a given data #' context. #' It is typically a matrix-like object, against which annotation specifications #' are matched using \code{\link{match_atrack}}. #' #' setMethod('.atrack', signature(object='ANY'), function(object, data=NULL, ...){ # recursive on list if( is.list(object) ){ object <- object[!sapply(object, function(x) length(x) == 0 || is_NA(x) )] res <- if( length(object) == 0 ) NULL else{ # convert into a list of tracks sapply(object, .atrack, data=data, ..., simplify=FALSE) } return(res) }else if( is.null(object) || is_NA(object) || is.atrack(object) ) object else{ # extend to match the data object <- match_atrack(object, data) # apply convertion rules for standard classes if( is.logical(object) ) aname(as.factor(ifelse(object, 1, NA)), "Flag") else if( is.integer(object) ){ if( any(wna <- is.na(object)) ) aname(as.factor(ifelse(!wna, 1,NA)), "Flag") else aname(as.numeric(object), "Level") } else if( is.character(object) ) aname(as.factor(object), "Group") else if( is.factor(object) ) aname(object, "Factor") else if( is.numeric(object) ) aname(object, "Variable") else stop("atrack - Invalid annotation item `" , substitute(object) , "`: must be a factor, or a logical, character, numeric or integer vector") } } ) setMethod('.atrack', 'character', function(object, ...){ # check for special escaped track code if( length(i <- atrack_code(object)) ){ if( length(object) == 1L ) object else if( length(i) == length(object) ) as.list(object) else{ # spe <- object[i] # object <- sub("^\\\\:", ":", object[-i]) # t <- callNextMethod() # c(list(t), spe) callNextMethod() } }else{ # object <- sub("^\\\\:", ":", object) callNextMethod() } } ) setMethod('.atrack', 'matrix', function(object, ...) .atrack(as.data.frame(object), ...) ) setMethod('.atrack', 'data.frame', function(object, ...) .atrack(as.list(object), ...) ) # tells if an object is a special annotation track code is_track_code <- function(x) isString(x) && grepl("^[:$]", x) atrack_code <- function(x, value=FALSE){ # check each track item ac <- sapply(x, is_track_code) i <- which(ac) if( !value ) i # return indexes else if( length(i) ) unlist(x[i]) # return values } match_atrack_code <- function(x, table, ...){ # pre-pend ':' table.plain <- sub("^:", '', table) table <- str_c(':', table.plain) # convert into an annotation track if( !is.atrack(x) ) x <- atrack(x, ...) m <- sapply(x, function(x){ if( isString(x) ) charmatch(x, table, nomatch=0L) else 0L }) if( length(i <- which(m!=0L)) ){ if( is.null(names(m)) ) names(m) <- rep('', length(m)) names(m)[i] <- table.plain[m[i]] } m } #' \code{atrack} creates/concatenates \code{annotationTrack} objects #' #' @param order an integer vector that indicates the order of the annotation #' tracks in the result list #' @param enforceNames logical that indicates if missing track names should #' be generated as \code{X} #' @param .SPECIAL an optional list of functions (with no arguments) that are #' called to generate special annotation tracks defined by codes of the form #' \code{':NAME'}. #' e.g., the function \code{link{consensusmap}} defines special tracks #' \code{':basis'} and \code{':consensus'}. #' #' If \code{.SPECIAL=FALSE}, then any special tracks is discarded and a warning #' is thrown. #' #' @param .DATA data used to match and extend annotation specifications. #' It is passed to argument \code{data} of the \code{.atrack} methods, which #' in turn use pass it to \code{\link{match_atrack}}. #' #' @param .CACHE an \code{annotationTrack} object with which the generated #' annotation track should be consistent. #' This argument is more for internal/advanced usage and should not be used #' by the end-user. #' #' @return \code{atrack} returns a list, decorated with class #' \code{'annotationTrack'}, where each element contains the description #' of an annotation track. #' #' @rdname atrack #' @export atrack <- function(..., order = NULL, enforceNames=FALSE, .SPECIAL=NA, .DATA = NULL, .CACHE = NULL){ # cbind object with the other arguments l <- list(...) if( length(l) == 1L && is.atrack(l[[1]]) ) object <- l[[1L]] else if( length(l) > 0 ){ object <- list() #print(l) lapply(seq_along(l), function(i){ x <- l[[i]] if( is_NA(x) || is.null(x) ) return() xa <- .atrack(x, data=.DATA) if( is_NA(xa) || is.null(xa) ) return() n <- names(object) # convert into a list if( !is.list(xa) ) xa <- setNames(list(xa), names(l)[i]) # remove NA and NULL elements if( is.null(xa) || is_NA(xa) ) return() # cbind with previous tracks if( is.null(object) ) object <<- xa else object <<- c(object, xa) }) } # exit now if object is NULL if( is.null(object) ) return() if( !length(object) ) return( annotationTrack() ) # add class 'annotationTrack' if not already there # (needed before calling match_atrack_code) object <- annotationTrack(object) # substitute special tracks if( is.list(.SPECIAL) ){ # str(object) m <- match_atrack_code(object, names(.SPECIAL)) i_spe <- which(m!=0L) if( length(i_spe) ){ # add names where needed if( is.null(names(object)) ) names(object) <- rep('', length(object)) # remove duplicated special tracks if( anyDuplicated(m[i_spe]) ){ # enforce name consistency if necessary g <- split(i_spe, m[i_spe]) sapply(g, function(i){ n <- names(object)[i] if( length(n <- n[n!='']) ) names(object)[i] <<- n[1L] }) # idup <- which(duplicated(m) & m!=0L) object <- object[-idup] m <- m[-idup] i_spe <- which(m!=0L) } # # enforce names consistent with the CACHE if( anyValue(.CACHE) ){ if( !is.atrack(.CACHE) ) stop("Argument .CACHE should be an annotation track object. [", class(.CACHE), ']') i_spe_cache <- atrack_code(.CACHE) if( length(i_spe_cache) ){ .CACHE_SPE <- unlist(.CACHE[i_spe_cache]) if( !is.null(names(.CACHE_SPE)) ){ sapply(i_spe, function(i){ x <- object[[i]] if( names(object)[i] == '' && !is_NA(j <- match(x, .CACHE_SPE)) && names(.CACHE_SPE)[j] != ''){ names(object)[i] <<- names(.CACHE_SPE)[j] } }) } } } # compute value a <- sapply(m[i_spe], function(i) .SPECIAL[[i]](), simplify=FALSE) object[i_spe] <- a # NB: this does not change the names # reset names nm <- names(object)[i_spe] names(object)[i_spe] <- ifelse(nm!='', nm, names(a)) } # remove special tracks if necessary if( length(i <- atrack_code(object)) ){ warning("Discarding unresolved special annotation tracks: " , str_out(unlist(object[i]), use.names=TRUE)) object <- object[-i] } } # generate names if( enforceNames ){ n <- names(object) xnames <- paste('X', 1:length(object), sep='') if( is.null(n) ) names(object) <- xnames else names(object)[n==''] <- xnames[n==''] } # reorder if necessary if( !is.null(order) ){ object <- sapply(object, function(x) x[order], simplify=FALSE) #lapply(seq_along(object), function(i) object[[i]] <<- object[[i]][order]) } #print(object) # return object annotationTrack(object) } #' \code{annotationTrack} is constructor function for \code{annotationTrack} object #' #' @rdname atrack annotationTrack <- function(x = list()){ if( !is.atrack(x) ) class(x) <- c('annotationTrack', if( nargs() ) class(x)) x } #setGeneric('atrack<-', function(object, value) standardGeneric('atrack<-')) #setReplaceMethod('atrack', signature(object='ANY', value='ANY'), # function(object, value){ # # if the annotation track is not NA: convert it into a atrack # # and set the value # if( !is_NA(object) && length(value) > 0 ){ # object <- atrack(object, value) # } # object # } #) #setReplaceMethod('atrack', signature(object='annotationTrack'), # function(object, value, replace = FALSE){ # if( !replace && length(value) > 0 ) atrack(object, value) # else if( replace ) atrack(value) # else object # } #) NMF/R/registry.R0000644000176000001440000000760612234465004013127 0ustar ripleyusers###% Define access/setup methods for NMF package registry. ###% ###% The registry is used to provide a common interface to NMF methods (algorithms, seeding methods, distance, ...). ###% It enables the user to add custom methods which will be accessible in the same way as the built-in ones. ###% ###% @author Renaud Gaujoux ###% @created 22 Jul 2009 ########################################################################### # COMMON REGISTRY ########################################################################### #' @import pkgmaker #' @import registry nmfRegistry <- function(...) pkgmaker::packageRegistry(...) # Returns the names of all the packages that contibute to all or a given # package's primary registry registryContributors <- function(package, regname = NULL){ regs <- packageRegistries(regname = regname, package = package, primary = TRUE) if( length(regs) ) unique(names(unlist(lapply(paste0(package, '::', regs), packageRegistries)))) } ###% Return a method stored in the NMF registry. ###% ###% @param name the key (a character string) of the method to be retrieved ###% @param regname the name of the sub-registry where to look for the \code{key} ###% @param exact a boolean. When set to \code{TRUE} the key is searched exactly, otherwise (default) the key ###% is matched partially with the keys registered in the registry. ###% @param error a boolean. When set to \code{TRUE} (default) the function will raise an error if the key is not found. ###% Otherwise it will not raise any error and return \code{NULL}. ###% nmfGet <- function(regname, name=NULL, ...){ # retrieve from the given package's sub-registry pkgmaker::pkgreg_fetch(regname, key=name, ...) } ###% Register a NMF method so that it is accessible via the common interface defined by the \code{nmf} function. ###% @param method an NMFStrategy object or a function that defines the method ###% @param key a non-empty character string that will be used as an identifier to access the method ###% @param overwrite a boolean that specify if an existing method (i.e. with exactly the same \code{key}) should be overwritten or not. ###% If \code{FALSE} and a method with the same key exists, an error will be thrown. ###% @param save [Not used] a boolean that if set to \code{TRUE} will save in database so that it is available in other R sessions. ###% @param ... [Not used] ###% ###% @return \code{TRUE} invisibly in case of success. ###% ###% @seealso nmf ###% setGeneric('nmfRegister', function(key, method, ...) standardGeneric('nmfRegister') ) setMethod('nmfRegister', signature(key='character'), function(key, method, regname, ...){ #TODO: add functionality to save the registered strategy into a file for use is other R sessions parent.method <- attr(method, 'parent') tmpl <- if( !is.null(parent.method) && parent.method != key ){ str_c(" based on template '", parent.method, "'") } setPackageRegistryEntry(regname, key, method, ..., where='NMF', msg=tmpl) } ) ####% Unregister a NMF method. ####% ####% @param name the key of the method to unregister [character string] ####% #nmfUnregister <- function(name, regname, quiet=FALSE){ # # return( pkgreg_remove(regname, key=name, quiet=quiet) ) # # add the strategy to the registry # obj <- nmfGet(name, exact=TRUE, error=FALSE, regname=regname) # regentry <- nmfRegistry(regname, entry=TRUE) # registry <- regentry$regobj # objtype <- regentry$entrydesc # # if( !is.null(obj) ){ # # get the method registry and the method's fullname # name <- attr(strategy, 'name') # # if( !quiet ){ # msg <- paste0("Removing ", objtype," '", name, "' from registry '", regname, "' [", class(obj), ']') # message(msg, ' ... ', appendLF=FALSE) # } # # delete from registry # registry$delete_entry(name) # if( !quiet ) message('OK') # TRUE # }else{ # if( !quiet ) # warning("Could not remove ", objtype, " '", name, "': no matching registry entry.", call.=FALSE) # FALSE # } #} NMF/R/algorithms-brunet.R0000644000176000001440000000166312305630424014721 0ustar ripleyusers# Original Matlab algorithm from Brunet et al. (2004) # # Author: Renaud Gaujoux # Created: 23 Nov 2012 ############################################################################### #' @include registry-algorithms.R NULL #' The algorithm \sQuote{.M#brunet} provide access to the \emph{original} Matlab #' algorithm from \cite{Brunet2004}, through the \pkg{RcppOctave} package. #' The Matlab code used can be found in the \pkg{NMF} package's 'm-files/' #' sub-directory: #' #' \samp{ #' library(RcppOctave) #' file.show(system.mfile('brunet.m', package='NMF')) #' } #' #' @rdname KL-nmf #' @aliases brunet_M-nmf nmfAlgorithm.brunet_M <- setNMFMethod('.M#brunet', , objective= 'KL' , mcode = 'brunet.m' , algorithm = function (y, x, verbose=nmf.getOption('verbose') , maxIter = nmf.getOption('maxIter') %||% 2000L){ RcppOctave::.CallOctave('brunet', y, nbasis(x), verbose, basis(x), coef(x), maxIter); } ) NMF/R/parallel.R0000644000176000001440000011474512530677555013075 0ustar ripleyusers# Definitions used in the parallel computations of NMF # # - reproducible backend # - reproducible %dopar% operator: %dorng% # # Author: Renaud Gaujoux # Creation: 08-Feb-2011 ############################################################################### #' @include utils.R #' @import foreach #' @import doParallel NULL # returns the number of cores to use in all NMF computation when no number is # specified by the user getMaxCores <- function(limit=TRUE){ #ceiling(parallel::detectCores()/2) nt <- n <- parallel::detectCores() # limit to number of cores specified in options if asked for if( limit ){ if( !is.null(nc <- getOption('cores')) ) n <- nc # global option else if( !is.null(nc <- nmf.getOption('cores')) ) n <- nc # NMF-specific option else if( n > 2 ) n <- n - 1L # leave one core free if possible } # forces limiting maximum number of cores to 2 during CRAN checks if( n > 2 && isCHECK() ){ message("# NOTE - CRAN check detected: limiting maximum number of cores [2/", nt, "]") n <- 2L } n } #' Utilities and Extensions for Foreach Loops #' #' \code{registerDoBackend} is a unified register function for foreach backends. #' #' @param object specification of a foreach backend, e.g. \sQuote{SEQ}, #' \sQuote{PAR} (for doParallel), \sQuote{MPI}, etc\ldots #' @param ... extra arguments passed to the backend own registration function. #' #' @keywords internal #' @rdname foreach registerDoBackend <- function(object, ...){ # restore old backend data in case of an error old <- getDoBackend() on.exit( setDoBackend(old) ) # get old foreach backend object ob <- ForeachBackend() # register new backend: call the register method b <- ForeachBackend(object, ...) res <- register(b) # cancel backend restoration on.exit() # call old backend cleanup method doBackendCleanup(ob) # return old backend invisible(ob) } #' \code{getDoBackend} returns the internal data of the currently registered foreach \%dopar\% backend. #' @rdname foreach #' @export getDoBackend <- function(){ fe_ns <- asNamespace('foreach') fe <- ns_get('.foreachGlobals', fe_ns) if( !exists("fun", where = fe, inherits = FALSE) ) return(NULL) getDoPar <- ns_get('getDoPar', fe_ns) c(getDoPar() # this returns the registered %dopar% function + associated data # -> add info function from foreach internal environment , info= if( exists("info", where = fe, inherits = FALSE) ){ get('info', fe, inherits=FALSE) }else{ function(data, item) NULL } , cleanup = if( exists("cleanup", where = fe, inherits = FALSE) ){ get('cleanup', fe, inherits=FALSE) } ) } getDoBackendInfo <- function(x, item){ if( is.function(x$info) ) x$info(x$data, item) } getDoBackendName <- function(x){ getDoBackendInfo(x, 'name') } #' \code{setDoBackend} is identical to \code{\link[foreach]{setDoPar}}, but #' returns the internal of the previously registered backend. #' #' @param data internal data of a foreach \%dopar\% backend. #' @param cleanup logical that indicates if the previous #' backend's cleanup procedure should be run, \strong{before} #' setting the new backend. #' #' @export #' @rdname foreach setDoBackend <- function(data, cleanup=FALSE){ # get old backend data ob <- getDoBackend() ofb <- ForeachBackend() # cleanup old backend if requested if( cleanup ){ doBackendCleanup(ofb) } if( !is.null(data) ){ bdata <- data if( is.backend(data) ) data <- data[!names(data) %in% c('name', 'cleanup')] do.call('setDoPar', data) setBackendCleanup(bdata) }else{ do.call('setDoPar', list(NULL)) fe <- ns_get('.foreachGlobals', 'foreach') if (exists("fun", envir = fe, inherits = FALSE)) remove("fun", envir = fe) setBackendCleanup(NULL) } # return old backend invisible(ob) } # setup cleanup procedure for the current backend setBackendCleanup <- function(object, fun, verbose=FALSE){ fe <- ns_get('.foreachGlobals', 'foreach') name <- getDoParName() if( !is.null(fun <- object$cleanup) ){ if( verbose ) message("# Registering cleaning up function for '", name, "'... ", appendLF=FALSE) assign('cleanup', fun, fe) if( verbose ) message("OK") }else if (exists("cleanup", envir = fe, inherits = FALSE)){ if( verbose ) message("# Removing cleaning up function for '", name, "'... ", appendLF=FALSE) remove("cleanup", envir = fe) if( verbose ) message("OK") } invisible(object) } # run cleanup procedure for a given backend object doBackendCleanup <- function(object, ..., run=TRUE, verbose=FALSE){ name <- object$name if( !is.null(fun <- object$cleanup) ){ if( verbose ) message("# Cleaning up '", name, "'... ", appendLF=FALSE) res <- try(fun(), silent=TRUE) if( verbose ) message(if( is(res, 'try-error') ) 'ERROR' else 'OK') if( isTRUE(res) ) object$cleanup <- NULL if( verbose ) message('OK', if( !is.null(res) ) str_c(' [', res,']')) } invisible(object) } #' \code{register} is a generic function that register objects. #' It is used to as a unified interface to register foreach backends. #' #' @param x specification of a foreach backend #' #' @rdname foreach #' @export register <- function(x, ...){ UseMethod('register', x) } #' @S3method register foreach_backend register.foreach_backend <- function(x, ...){ be <- x$name # For everything except doSEQ: # require definition package (it is safer to re-check) if( be != 'doSEQ' ){ if( !require.quiet(be, character.only=TRUE) ) stop("Package '", be, "' is required to use foreach backend '", be, "'") } regfun <- .foreach_regfun(x$name) res <- if( length(formals(regfun)) > 0L ) do.call(regfun, c(x$data, ...)) else regfun() # throw an error if not successful (foreach::setDoPar do not throw errors!!) if( is(res, 'simpleError') ) stop(res) # set cleanup procedure if any setBackendCleanup(x) # return result invisible(res) } #' \code{ForeachBackend} is a factory method for foreach backend objects. #' #' @export #' @inline #' @rdname foreach setGeneric('ForeachBackend', function(object, ...) standardGeneric('ForeachBackend')) #' Default method defined to throw an informative error message, when no other #' method was found. setMethod('ForeachBackend', 'ANY', function(object, ...){ if( is.backend(object) ){ # update arg list if necessary if( nargs() > 1L ) object$data <- list(...) object }else if( is(object, 'cluster') ) selectMethod('ForeachBackend', 'cluster')(object, ...) else stop("Could not create foreach backend object with a specification of class '", class(object)[1L], "'") } ) formatDoName <- function(x){ # numeric values are resolved as doParallel if( is.numeric(x) ) x <- 'PAR' if( is.character(x) ){ # use upper case if not already specified as 'do*' if( !grepl("^do", x) ){ x <- toupper(x) # special treatment for doParallel if( x %in% c('PAR', 'PARALLEL') ) x <- 'Parallel' } # stick prefix 'do' (removing leading 'do' if necessary) str_c('do', sub('^do', '', x)) }else '' } #' Creates a foreach backend object based on its name. setMethod('ForeachBackend', 'character', function(object, ...){ object <- formatDoName(object) # build S3 class name s3class <- str_c(object, "_backend") # create empty S3 object obj <- structure(list(name=object, data=list(...)) , class=c(s3class, 'foreach_backend')) # give a chance to a backend-specific ForeachBackend factory method # => this will generally fill the object with the elements suitable # to be used in a call to foreach::setDoPar: fun, data, info # and possibly change the name or the object class, e.g. to allow # subsequent argument-dependent dispatch. obj <- ForeachBackend(obj, ...) # check the registration routine is available .foreach_regfun(obj$name) # set data slot if not already set by the backend-specific method if( is.null(obj$data) || (length(obj$data) == 0L && nargs()>1L) ) obj$data <- list(...) # return object obj } ) #' Creates a foreach backend object for the currently registered backend. setMethod('ForeachBackend', 'missing', function(object, ...){ be <- getDoParName() data <- getDoBackend() bdata <- data$data res <- if( !is.null(bdata) ) do.call(ForeachBackend, c(list(be, bdata), ...)) else ForeachBackend(be, ...) if( !is.null(data$cleanup) ) res$cleanup <- data$cleanup res } ) #' Dummy method that returns \code{NULL}, defined for correct dispatch. setMethod('ForeachBackend', 'NULL', function(object, ...){ NULL }) setOldClass('cluster') #' Creates a doParallel foreach backend that uses the cluster described in #' \code{object}. setMethod('ForeachBackend', 'cluster', function(object, ...){ ForeachBackend('doParallel', cl=object) } ) #' Creates a doParallel foreach backend with \code{object} processes. setMethod('ForeachBackend', 'numeric', function(object, ...){ # check numeric specification if( length(object) == 0L ) stop("invalid number of cores specified as a backend [empty]") object <- object[1] if( object <= 0 ) stop("invalid negative number of cores [", object, "] specified for backend 'doParallel'") ForeachBackend('doParallel', cl=object, ...) } ) ############### # doParallel ############### setOldClass('doParallel_backend') #' doParallel-specific backend factory #' #' @param cl cluster specification: a cluster object or a numeric that indicates the #' number of nodes to use. #' @param type type of cluster, See \code{\link[parallel]{makeCluster}}. setMethod('ForeachBackend', 'doParallel_backend', function(object, cl, type=NULL){ # set type of cluster if explicitly provided if( !is.null(type) ) object$data$type <- type # required registration data # NB: a function doParallel:::doParallel should exist and do the same # thing as parallel::registerDoParallel without registering the backend #object$fun <- doParallel:::doParallel # object$info <- doParallel:::info # doParallel:::info has been removed from doParallel since version 1.0.7 # Reported in Issue #7 object$info <- getDoParallelInfo(object) # return object object } ) setOldClass('doParallelMC_backend') #' doParallel-specific backend factory for multicore (fork) clusters #' #' This method is needed since version 1.0.7 of \pkg{doParallel}, which removed #' internal function \code{info} and defined separate backend names for mc and snow clusters. setMethod('ForeachBackend', 'doParallelMC_backend', function(object, ...){ object$info <- getDoParallelInfo('mc') object$name <- 'doParallel' # return object object } ) setOldClass('doParallelSNOW_backend') #' doParallel-specific backend factory for SNOW clusters. #' #' This method is needed since version 1.0.7 of \pkg{doParallel}, which removed #' internal function \code{info} and defined separate backend names for mc and snow clusters. setMethod('ForeachBackend', 'doParallelSNOW_backend', function(object, ...){ object$info <- getDoParallelInfo('snow') object$name <- 'doParallel' # return object object } ) getDoParallelType <- function(x){ cl <- x$data[['cl']] if( is.null(cl) && length(x$data) && (is.null(names(x$data)) || names(x$data)[[1L]] == '') ) cl <- x$data[[1L]] if ( is.null(cl) || is.numeric(cl) ) { if (.Platform$OS.type == "windows" || (!is.null(x$data$type) && !identical(x$data$type, 'FORK')) ) 'snow' else 'mc' } else 'snow' } getDoParallelInfo <- function(x, ...){ t <- if( isString(x) ) x else getDoParallelType(x, ...) # str(t) ns <- asNamespace('doParallel') if( t == 'mc' ) get('mcinfo', ns) else get('snowinfo', ns) } ###################################################### # doPSOCK # Default snow-like cluster from parallel on Windows # but works on Unix as well ###################################################### setOldClass('doPSOCK_backend') #' doSNOW-specific backend factory setMethod('ForeachBackend', 'doPSOCK_backend', function(object, cl){ # use all available cores if not otherwise specified if( missing(cl) ) cl <- getMaxCores() # return equivalent doParallel object ForeachBackend('doParallel', cl, type='PSOCK') } ) .cl_cleanup <- function(gvar, envir=.GlobalEnv){ if( !exists(gvar, envir = envir) ) return() cl <- get(gvar, envir = envir) try( parallel::stopCluster(cl), silent=TRUE) rm(list=gvar, envir = envir) TRUE } cleanupCluster <- function(x, cl, stopFun=NULL){ function(){ if( is(x, 'doParallel_backend') ){ # On non-Windows machines registerDoParallel(numeric) will use # parallel::mclapply with `object` cores (no cleanup required). # On Windows doParallel::registerDoParallel(numeric) will create a # SOCKcluster with `object` cores. # => Windows needs a cleanup function that will stop the cluster # when another backend is registered. # Fortunately doParallel::registerDoParallel assign the cluster object # to the global variable `.revoDoParCluster` if( .Platform$OS.type == "windows" ){ .cl_cleanup(".revoDoParCluster") } } if( is.null(stopFun) ) stopFun <- parallel::stopCluster # stop cluster stopFun(cl) TRUE } } #' @S3method register doParallel_backend register.doParallel_backend <- function(x, ...){ # start cluster if numeric specification and type is defined cl <- x$data[[1]] if( is.numeric(cl) && (.Platform$OS.type == 'windows' || !is.null(x$data$type)) ){ names(x$data)[1L] <- 'spec' # start cluster clObj <- do.call(parallel::makeCluster, x$data) x$data <- list(clObj) # setup cleanup procedure x$cleanup <- cleanupCluster(x, clObj) } # register register.foreach_backend(x, ...) } ############### # doMPI ############### isMPIBackend <- function(x, ...){ b <- if( missing(x) ) ForeachBackend(...) else ForeachBackend(object=x, ...) if( is.null(b) ) FALSE else if( identical(b$name, 'doMPI') ) TRUE else if( length(b$data) ){ is(b$data[[1]], 'MPIcluster') || is(b$data[[1]], 'mpicluster') }else FALSE } #' @S3method register doMPI_backend register.doMPI_backend <- function(x, ...){ if( length(x$data) && isNumber(cl <- x$data[[1]]) ){ clObj <- doMPI::startMPIcluster(cl) x$data[[1]] <- clObj # setup cleanup procedure x$cleanup <- cleanupCluster(x, clObj, doMPI::closeCluster) } # register register.foreach_backend(x, ...) } setOldClass('mpicluster') #' Creates a doMPI foreach backend that uses the MPI cluster described in #' \code{object}. setMethod('ForeachBackend', 'mpicluster', function(object, ...){ ForeachBackend('doMPI', cl=object) } ) setOldClass('doMPI_backend') #' doMPI-specific backend factory setMethod('ForeachBackend', 'doMPI_backend', function(object, cl){ # use all available cores if not otherwise specified if( missing(cl) ) cl <- getMaxCores() # required registration data object$fun <- doMPI:::doMPI object$info <- doMPI:::info # return object object } ) #as.foreach_backend <- function(x, ...){ # # args <- list(...) # if( is.backend(x) ){ # # update arg list if necessary # if( length(args) > 0L ) x$args <- args # return(x) # } # # be <- # if( is.null(x) ){ # getDoParName() # } else if( is(x, 'cluster') || is.numeric(x) ){ # # check numeric specification # if( is.numeric(x) ){ # if( length(x) == 0L ) # stop("invalid number of cores specified as a backend [empty]") # x <- x[1] # if( x <= 0 ) # stop("invalid negative number of cores [", x, "] specified for backend 'doParallel'") # } # # args$spec <- x # 'Parallel' # } else if( is(x, 'mpicluster') ){ # args$spec <- x # 'MPI' # } else if( is.character(x) ){ # toupper(x) # } else # stop("invalid backend specification: must be NULL, a valid backend name, a numeric value or a cluster object [", class(x)[1L], "]") # # if( be %in% c('PAR', 'PARALLEL') ) be <- 'Parallel' # # remove leading 'do' # be <- str_c('do', sub('^do', '', be)) # # build S3 class name # s3class <- str_c(be, "_backend") # # # check the registration routine is available # regfun <- .foreach_regfun(be) # # structure(list(name=be, args=args), class=c(s3class, 'foreach_backend')) #} is.backend <- function(x) is(x, 'foreach_backend') #' @S3method print foreach_backend print.foreach_backend <- function(x, ...){ cat("\n", sep='') if( length(x$data) ){ cat("Specifications:\n") str(x$data) } } .foreach_regfun <- function(name){ # early exit for doSEQ if( name == 'doSEQ' ) return( registerDoSEQ ) # build name of registration function s <- str_c(toupper(substring(name, 1,1)), substring(name, 2)) funname <- str_c('register', s) s3class <- str_c(name, "_backend") # require definition package if( !require.quiet(name, character.only=TRUE) ) stop("could not find package for foreach backend '", name, "'") # check for registering function or generic if( is.null(regfun <- getFunction(funname, mustFind=FALSE, where=asNamespace(name))) ){ if( is.null(regfun <- getS3method('register', s3class, optional=TRUE)) ) stop("could not find registration routine for foreach backend '", name, "'") # stop("backend '", name,"' is not supported: function " # ,"`", regfun, "` and S3 method `register.", s3class, "` not found.") } regfun } #' \code{getDoParHosts} is a generic function that returns the hostname of the worker nodes used by a backend. #' #' @export #' @rdname foreach #' @inline setGeneric('getDoParHosts', function(object, ...) standardGeneric('getDoParHosts')) setOldClass('foreach_backend') #' Default method that tries to heuristaically infer the number of hosts and in last #' resort temporarly register the backend and performs a foreach loop, to retrieve the #' nodename from each worker. setMethod('getDoParHosts', 'ANY', function(object, ...){ be <- if( missing(object) ) ForeachBackend(...) else ForeachBackend(object, ...) if( existsMethod('getDoParHosts', class(be)[1L]) ) return( callGeneric(object) ) # default behaviour nodename <- setNames(Sys.info()['nodename'], NULL) if( is.null(be) || is.null(be$data) ) return( NULL ) # doSEQ if( be$name == 'doSEQ' ) return( nodename ) if( isNumber(be$data) ) return( rep(nodename, be$data) ) if( length(be$data) && isNumber(be$data[[1]]) ) return( rep(nodename, be$data[[1]]) ) if( length(be$data) && be$name == 'doParallel' ) return( sapply(be$data[[1L]], '[[', 'host') ) if( !missing(object) ){ # backend passed: register temporarly ob <- getDoBackend() on.exit( setDoBackend(ob) ) registerDoBackend(be) } setNames(unlist(times(getDoParWorkers()) %dopar% { Sys.info()['nodename'] }), NULL) } ) #' \code{getDoParNHosts} returns the number of hosts used by a backend. #' #' @export #' @rdname foreach getDoParNHosts <- function(object){ if( missing(object) ) foreach::getDoParWorkers() else{ length(getDoParHosts(object)) } } # add new option: limit.cores indicates if the number of cores used in parallel # computation can exceed the detected number of CPUs on the host. #.OPTIONS$newOptions(limit.cores=TRUE) #' Computational Setup Functions #' #' @description #' Functions used internally to setup the computational environment. #' #' \code{setupBackend} sets up a foreach backend given some specifications. #' #' @param spec target parallel specification: either \code{TRUE} or \code{FALSE}, #' or a single numeric value that specifies the number of cores to setup. #' @param backend value from argument \code{.pbackend} of \code{nmf}. #' @param optional a logical that indicates if the specification must be fully #' satisfied, throwing an error if it is not, or if one can switch back to #' sequential, only outputting a verbose message. #' @param verbose logical or integer level of verbosity for message outputs. #' #' @return Returns \code{FALSE} if no foreach backend is to be used, \code{NA} if the currently #' registered backend is to be used, or, if this function call registered a new backend, #' the previously registered backend as a \code{foreach} object, so that it can be restored #' after the computation is over. #' @keywords internals #' @rdname setup setupBackend <- function(spec, backend, optional=FALSE, verbose=FALSE){ pbackend <- backend str_backend <- quick_str(pbackend) # early exit: FALSE specification or NA backend means not using foreach at all if( isFALSE(spec) || is_NA(pbackend) ) return(FALSE) # use doParallel with number of cores if specified in backend if( is.numeric(pbackend) ){ spec <- pbackend pbackend <- 'PAR' } # identify doSEQ calls doSEQ <- formatDoName(pbackend) == 'doSEQ' # custom error function pcomp <- is.numeric(spec) && !identical(spec[1], 1) errorFun <- function(value=FALSE, stop=FALSE, level=1){ function(e, ...){ if( !is(e, 'error') ) e <- list(message=str_c(e, ...)) pref <- if( pcomp ) "Parallel" else "Foreach" if( !optional || stop ){ if( verbose >= level ) message('ERROR') stop(pref, " computation aborted: ", e$message, call.=FALSE) }else if( verbose >= level ){ message('NOTE') message("# NOTE: ", pref, " computation disabled: ", e$message) } value } } # check current backend if backend is NULL if( is.null(pbackend) ){ if( verbose > 1 ){ message("# Using current backend ... ", appendLF=FALSE) } ok <- tryCatch({ if( is.null(parname <- getDoParName()) ) stop("argument '.pbackend' is NULL but there is no registered backend") if( verbose > 1 ) message('OK [', parname, ']') TRUE }, error = errorFun()) if( !ok ) return(FALSE) # exit now since there is nothing to setup, nothing should change # return NULL so that the backend is not restored on.exit of the parent call. return(NA) } ## # test if requested number of cores is actually available NCORES <- getMaxCores(limit=FALSE) if( verbose > 2 ) message("# Check available cores ... [", NCORES, ']') if( verbose > 2 ) message("# Check requested cores ... ", appendLF=FALSE) ncores <- if( doSEQ ) 1L else{ ncores <- tryCatch({ if( is.numeric(spec) ){ if( length(spec) == 0L ) stop("no number of cores specified for backend '", str_backend, "'") spec <- spec[1] if( spec <= 0L ) stop("invalid negative number of cores [", spec, "] specified for backend '", str_backend, "'") spec }else # by default use the 'cores' option or half the number of cores getMaxCores() #getOption('cores', ceiling(NCORES/2)) }, error = errorFun(stop=TRUE)) if( isFALSE(ncores) ) return(FALSE) ncores } if( verbose > 2 ) message('[', ncores, ']') # create backend object if( verbose > 2 ) message("# Loading backend for specification `", str_backend, "` ... ", appendLF=FALSE) newBackend <- tryCatch({ # NB: limit to the number of cores available on the host if( !doSEQ ) ForeachBackend(pbackend, min(ncores, NCORES)) else ForeachBackend(pbackend) }, error = errorFun(level=3)) if( isFALSE(newBackend) ) return(FALSE) if( verbose > 2 ) message('OK') if( verbose > 1 ) message("# Check host compatibility ... ", appendLF=FALSE) ok <- tryCatch({ # check if we're not running on MAC from GUI if( is.Mac(check.gui=TRUE) && (newBackend$name == 'doMC' || (newBackend$name == 'doParallel' && is.numeric(newBackend$data[[1]]))) ){ # error only if the parallel computation was explicitly asked by the user stop("multicore parallel computations are not safe from R.app on Mac OS X." , "\n -> Use a terminal session, starting R from the command line.") } TRUE }, error = errorFun()) if( !ok ) return(FALSE) if( verbose > 1 ) message('OK') if( verbose > 1 ) message("# Registering backend `", newBackend$name, "` ... ", appendLF=FALSE) # try registering the backend oldBackend <- getDoBackend() # setup retoration of backend in case of an error # NB: the new backend cleanup will happens only # if regsitration succeeds, since the cleanup routine is # setup after the registration by the suitable register S3 method. on.exit( setDoBackend(oldBackend, cleanup=TRUE) ) ov <- lverbose(verbose) ok <- tryCatch({ registerDoBackend(newBackend) TRUE } , error ={ lverbose(ov) errorFun() }) lverbose(ov) if( !ok ) return(FALSE) if( verbose > 1 ) message('OK') # check allocated cores if not doSEQ backend if( newBackend$name != 'doSEQ' ){ # test allocated number of cores if( verbose > 2 ) message("# Check allocated cores ... ", appendLF=FALSE) wcores <- getDoParWorkers() if( ncores > 0L && wcores < ncores ){ if( !optional ){ errorFun(level=3)("only ", wcores, " core(s) available [requested ", ncores ," core(s)]") }else if( verbose > 2 ){ message('NOTE [', wcores, '/', ncores, ']') message("# NOTE: using only ", wcores, " core(s) [requested ", ncores ," core(s)]") } } else if( verbose > 2 ){ message('OK [', wcores, '/', ncores , if(ncores != NCORES ) str_c(' out of ', NCORES) , ']') } } # cancel backend restoration on.exit() # return old backend oldBackend } # add extra package bigmemory and synchronicity on Unix platforms if( .Platform$OS.type != 'windows' ){ setPackageExtra('install.packages', 'bigmemory', pkgs='bigmemory') setPackageExtra('install.packages', 'synchronicity', pkgs='synchronicity') } # add new option: shared.memory that indicates if one should try using shared memory # to speed-up parallel computations. .OPTIONS$newOptions(shared.memory = (.Platform$OS.type != 'windows' && !is.Mac())) #' \code{setupSharedMemory} checks if one can use the packages \emph{bigmemory} and \emph{sychronicity} #' to speed-up parallel computations when not keeping all the fits. #' When both these packages are available, only one result per host is written on disk, #' with its achieved deviance stored in shared memory, that is accessible to all cores on #' a same host. #' It returns \code{TRUE} if both packages are available and NMF option \code{'shared'} is #' toggled on. #' #' @rdname setup setupSharedMemory <- function(verbose){ if( verbose > 1 ) message("# Check shared memory capability ... ", appendLF=FALSE) # early exit if option shared is off if( !nmf.getOption('shared.memory') ){ if( verbose > 1 ) message('SKIP [disabled]') return(FALSE) } # early exit if foreach backend is doMPI: it is not working, not sure why if( isMPIBackend() ){ if( verbose > 1 ) message('SKIP [MPI cluster]') return(FALSE) } # not on Windows if( .Platform$OS.type == 'windows' ){ if( verbose > 1 ) message('SKIP [Windows OS]') return(FALSE) } if( !require.quiet('bigmemory', character.only=TRUE) ){ if( verbose > 1 ){ message('NO', if( verbose > 2 ) ' [Package `bigmemory` required]') } return(FALSE) } if( !require.quiet('synchronicity', character.only=TRUE) ){ if( verbose > 1 ){ message('NO', if( verbose > 2 ) ' [Package `synchronicity` required]') } return(FALSE) } if( verbose > 1 ) message('YES', if( verbose > 2 ) ' [synchronicity]') TRUE } is.doSEQ <- function(){ dn <- getDoParName() is.null(dn) || dn == 'doSEQ' } #' \code{setupTempDirectory} creates a temporary directory to store the best fits computed on each host. #' It ensures each worker process has access to it. #' #' @rdname setup setupTempDirectory <- function(verbose){ # - Create a temporary directory to store the best fits computed on each host NMF_TMPDIR <- tempfile('NMF_', getwd()) if( verbose > 2 ) message("# Setup temporary directory: '", NMF_TMPDIR, "' ... ", appendLF=FALSE) dir.create(NMF_TMPDIR) if( !is.dir(NMF_TMPDIR) ){ if( verbose > 2 ) message('ERROR') nmf_stop('nmf', "could not create temporary result directory '", NMF_TMPDIR, "'") } on.exit( unlink(NMF_TMPDIR, recursive=TRUE) ) # ensure that all workers can see the temporary directory wd <- times(getDoParWorkers()) %dopar% { if( !file_test('-d', NMF_TMPDIR) ) dir.create(NMF_TMPDIR, recursive=TRUE) file_test('-d', NMF_TMPDIR) } # check it worked if( any(!wd) ){ if( verbose > 2 ) message('ERROR') nmf_stop('nmf', "could not create/see temporary result directory '", NMF_TMPDIR, "' on worker nodes ", str_out(which(!wd), Inf)) } if( verbose > 2 ) message('OK') on.exit() NMF_TMPDIR } #' Utilities for Parallel Computations #' #' #' @rdname parallel #' @name parallel-NMF NULL #' \code{ts_eval} generates a thread safe version of \code{\link{eval}}. #' It uses boost mutexes provided by the \code{\link[synchronicity]{synchronicity}} #' package. #' The generated function has arguments \code{expr} and \code{envir}, which are passed #' to \code{\link{eval}}. #' #' @param mutex a mutex or a mutex descriptor. #' If missing, a new mutex is created via the function \code{\link[synchronicity]{boost.mutex}}. #' @param verbose a logical that indicates if messages should be printed when #' locking and unlocking the mutex. #' #' @rdname parallel #' @export ts_eval <- function(mutex = synchronicity::boost.mutex(), verbose=FALSE){ requireNamespace('bigmemory') #library(bigmemory) requireNamespace('synchronicity') #library(synchronicity) # describe mutex if necessary .MUTEX_DESC <- if( is(mutex, 'boost.mutex') ) synchronicity::describe(mutex) else mutex loadpkg <- TRUE function(expr, envir=parent.frame()){ # load packages once if( loadpkg ){ requireNamespace('bigmemory') #library(bigmemory) requireNamespace('synchronicity') #library(synchronicity) loadpkg <<- FALSE } MUTEX <- synchronicity::attach.mutex(.MUTEX_DESC) synchronicity::lock(MUTEX) if( verbose ) message('#', Sys.getpid(), " - START mutex: ", .MUTEX_DESC@description$shared.name) ERROR <- "### ###\n" on.exit({ if( verbose ){ message(ERROR, '#', Sys.getpid(), " - END mutex: ", .MUTEX_DESC@description$shared.name) } synchronicity::unlock(MUTEX) }) eval(expr, envir=envir) ERROR <- NULL } } #' \code{ts_tempfile} generates a \emph{unique} temporary filename #' that includes the name of the host machine and/or the caller's process id, #' so that it is thread safe. #' #' @inheritParams base::tempfile #' @param ... extra arguments passed to \code{\link[base]{tempfile}}. #' @param host logical that indicates if the host machine name should #' be appear in the filename. #' @param pid logical that indicates if the current process id #' be appear in the filename. #' #' @rdname parallel #' @export ts_tempfile <- function(pattern = "file", ..., host=TRUE, pid=TRUE){ if( host ) pattern <- c(pattern, Sys.info()['nodename']) if( pid ) pattern <- c(pattern, Sys.getpid()) tempfile(paste(pattern, collapse='_'), ...) } #' \code{hostfile} generates a temporary filename composed with #' the name of the host machine and/or the current process id. #' #' @inheritParams base::tempfile #' @inheritParams ts_tempfile #' #' @rdname parallel #' @export hostfile <- function(pattern = "file", tmpdir=tempdir(), fileext='', host=TRUE, pid=TRUE){ if( host ) pattern <- c(pattern, Sys.info()['nodename']) if( pid ) pattern <- c(pattern, Sys.getpid()) file.path(tmpdir, str_c(paste(pattern, collapse='.'), fileext)) } #' \code{gVariable} generates a function that access a global static variable, #' possibly in shared memory (only for numeric matrix-coercible data in this case). #' It is used primarily in parallel computations, to preserve data accross #' computations that are performed by the same process. #' #' @param init initial value #' @param shared a logical that indicates if the variable should be stored in shared #' memory or in a local environment. #' #' @rdname parallel #' @export gVariable <- function(init, shared=FALSE){ if( shared ){ # use bigmemory shared matrices if( !is.matrix(init) ) init <- as.matrix(init) requireNamespace('bigmemory') #library(bigmemory) DATA <- bigmemory::as.big.matrix(init, type='double', shared=TRUE) DATA_DESC <- bigmemory::describe(DATA) }else{ # use variables assigned to .GlobalEnv DATA_DESC <- basename(tempfile('.gVariable_')) } .VALUE <- NULL .loadpkg <- TRUE function(value){ # load packages once if( shared && .loadpkg ){ requireNamespace('bigmemory') #library(bigmemory) .loadpkg <<- FALSE } # if shared: attach bigmemory matrix from its descriptor object if( shared ){ DATA <- bigmemory::attach.big.matrix(DATA_DESC) } if( missing(value) ){# READ ACCESS if( !shared ){ # initialise on first call if necessary if( is.null(.VALUE) ) .VALUE <<- init # return variable .VALUE }else DATA[] }else{# WRITE ACCESS if( !shared ) .VALUE <<- value else DATA[] <- value } } } #' \code{setupLibPaths} add the path to the NMF package to each workers' libPaths. #' #' @param pkg package name whose path should be exported the workers. #' #' @rdname setup setupLibPaths <- function(pkg='NMF', verbose=FALSE){ # do nothing in sequential mode if( is.doSEQ() ) return( character() ) if( verbose ){ message("# Setting up libpath on workers for package(s) " , str_out(pkg, Inf), ' ... ', appendLF=FALSE) } p <- path.package(pkg) if( is.null(p) ) return() if( !isDevNamespace(pkg) ){ # not a dev package plibs <- dirname(p) libs <- times(getDoParWorkers()) %dopar% { .libPaths(c(.libPaths(), plibs)) } libs <- unique(unlist(libs)) if( verbose ){ message("OK\n# libPaths:\n", paste(' ', libs, collapse="\n")) } libs pkg }else if( getDoParName() != 'doParallel' || !isNumber(getDoBackend()$data) ){ # devmode: load the package + depends if( verbose ){ message("[devtools::load_all] ", appendLF=FALSE) } times(getDoParWorkers()) %dopar% { capture.output({ suppressMessages({ requireNamespace('devtools') #library(devtools) requireNamespace('bigmemory') #library(bigmemory) devtools::load_all(p) }) }) } if( verbose ){ message("OK") } c('bigmemory', 'rngtools') } else if( verbose ){ message("OK") } } #StaticWorkspace <- function(..., .SHARED=FALSE){ # # # create environment # e <- new.env(parent=.GlobalEnv) # # fill with initial data # vars <- list(...) # if( .SHARED ){ # lapply(names(vars), function(x){ # bm <- bigmemory::as.big.matrix(vars[[x]], type='double', shared=TRUE) # e[[x]] <- bigmemory::describe(bm) # }) # }else # list2env(vars, envir=e) # # structure(e, shared=.SHARED, class=c("static_wsp", 'environment')) #} # #`[[.static_wsp` <- function(x, ..., exact = TRUE){ # if( attr(x, 'shared') ){ # var <- bigmemory::attach.big.matrix(NextMethod()) # var[] # }else # NextMethod() #} # #`[[.static_wsp<-` <- function(x, i, value){ # # if( attr(x, 'shared') ){ # var <- bigmemory::attach.big.matrix(x[[i]]) # var[] <- value # }else # x[[i]] <- value # x #} isRNGseed <- function(x){ is.numeric(x) || ( is.list(x) && is.null(names(x)) && all(sapply(x, is.numeric)) ) } #' \code{setupRNG} sets the RNG for use by the function nmf. #' It returns the old RNG as an rstream object or the result of set.seed #' if the RNG is not changed due to one of the following reason: #' - the settings are not compatible with rstream #' #' @param seed initial RNG seed specification #' @param n number of RNG seeds to generate #' #' @rdname setup setupRNG <- function(seed, n, verbose=FALSE){ if( verbose == 2 ){ message("# Setting up RNG ... ", appendLF=FALSE) on.exit( if( verbose == 2 ) message("OK") ) }else if( verbose > 2 ) message("# Setting up RNG ... ") if( verbose > 3 ){ message("# ** Original RNG settings:") showRNG() } # for multiple runs one always uses RNGstreams if( n > 1 ){ # seeding with numeric values only if( is.list(seed) && isRNGseed(seed) ){ if( length(seed) != n ) stop("Invalid list of RNG seeds: must be of length ", n) if( verbose > 2 ) message("# Using supplied list of RNG seeds") return(seed) }else if( is.numeric(seed) ){ if( verbose > 2 ){ message("# Generate RNGStream sequence using seed (" , RNGstr(seed), ") ... " , appendLF=FALSE) } res <- RNGseq(n, seed) if( verbose > 2 ) message("OK") return(res) }else{ # create a sequence of RNGstream using a random seed if( verbose > 2 ){ message("# Generate RNGStream sequence using a random seed ... " , appendLF=FALSE) } res <- RNGseq(n, NULL) if( verbose > 2 ) message("OK") return(res) } }else if( is.numeric(seed) ){ # for single runs: 1-length seeds are used to set the current RNG # 6-length seeds are used to set RNGstream if( !is.vector(seed) ){ message('ERROR') stop("NMF::nmf - Invalid numeric seed: expects a numeric vector.") } # convert to an integer vector seed <- as.integer(seed) # immediately setup the RNG in the standard way if( length(seed) == 1L ){ if( verbose > 2 ){ message("# RNG setup: standard [seeding current RNG]") message("# Seeding current RNG with seed (", seed, ") ... " , appendLF=FALSE) } set.seed(seed) if( verbose > 2 ) message("OK") return( getRNG() ) }else if( length(seed) == 6L ){ if( verbose > 2 ){ message("# RNG setup: reproducible [using RNGstream]") message("# Generate RNGStream sequence using seed (" , RNGstr(seed), ") ... " , appendLF=FALSE) } res <- RNGseq(1, seed) setRNG(res) if( verbose > 2 ) message("OK") return( res ) }else{ if( verbose > 2 ){ message("# RNG setup: directly setting RNG") message("# Setting RNG with .Random.seed= (" , RNGstr(seed), ") ... " , appendLF=FALSE) } setRNG(seed, verbose > 2) if( verbose > 2 ) message("OK") return( getRNG() ) } stop("NMF::nmf - Invalid numeric seed: unexpected error.") }else{ if( verbose > 2 ) message("# RNG setup: standard [using current RNG]") NULL } } ################################################################## ## END ################################################################## NMF/R/seed-base.R0000644000176000001440000000060712234465004013101 0ustar ripleyusers# Basic NMF seeding methods # # Author: Renaud Gaujoux ############################################################################### #' @include registry-seed.R NULL ## Register base seeding methods # None: do nothing and return object unchanged setNMFSeed('none', function(object, x, ...){object}, overwrite=TRUE) # Random: use function rnmf setNMFSeed('random', rnmf, overwrite=TRUE) NMF/R/versions.R0000644000176000001440000001330412234465004013117 0ustar ripleyusers# Tracking/Updating S4 class versions # # Author: Renaud Gaujoux ############################################################################### #' @include utils.R NULL objectUpdater <- local({ .REGISTRY <- list() function(x, version=NULL, fun=NULL, vfun=NULL, verbose=FALSE){ if( missing(x) ) return( .REGISTRY ) if( is.null(version) ){ cl <- class(x) UPDATER <- .REGISTRY[[cl]] vmsg <- 'Class' if( is.character(verbose) ){ vmsg <- paste(verbose, ':', sep='') verbose <- TRUE } if( verbose ) message("# ", vmsg, " '", cl, "' ... ", appendLF=FALSE) if( !isS4(x) ){ if( verbose) message("NO") return(x) } # create new object from old slots newObject <- if( verbose ){ message() updateObjectFromSlots(x, verbose=verbose>1) }else suppressWarnings( updateObjectFromSlots(x, verbose=verbose>1) ) if( is.null(UPDATER) ){ if( verbose) message("AUTO") return(newObject) } # find object version v <- sapply(UPDATER, function(f) f$vfun(x)) v <- which(v) if( !length(v) ){ if( verbose) message("SKIP [version unknown]") return(newObject) } if( length(v) > 1L ){ warning("Object matched multiple version of class '", cl , "' [", paste(names(UPDATER)[v], collapse=", "), "]") if( verbose) message("SKIP [multiple versions]") return(newObject) }else if( verbose) message("UPDATING [", appendLF=FALSE) for(n in names(UPDATER[v[1L]])){ f <- UPDATER[[n]] if( verbose ) message(n, ' -> ', appendLF=FALSE) newObject <- f$fun(x, newObject) } if( verbose ) message("*]") # return updated object return(newObject) } stopifnot( is.character(x) ) if( is.null(version) ){ if( !is.null(fun) || !is.null(vfun) ) stop("Argument `version` is required for defining updater functions for class `", x, "`") return(.REGISTRY[[x]]) } if( is.null(.REGISTRY[[x]]) ) .REGISTRY[[x]] <<- list() # check result is a function stopifnot(is.function(fun)) stopifnot(is.function(vfun)) if( !is.null(.REGISTRY[[x]][[version]]) ) stop("An update for class '", x, "' version ", version, " is already defined") .REGISTRY[[x]][[version]] <<- list(vfun=vfun, fun=fun) # put updaters in order .REGISTRY[[x]] <<- .REGISTRY[[x]][orderVersion(names(.REGISTRY[[x]]))] invisible(.REGISTRY[[x]]) } }) # Taken from BiocGenerics 2.16 getObjectSlots <- function (object) { if (!is.object(object) || isVirtualClass(class(object))) return(NULL) value <- attributes(object) value$class <- NULL if (is(object, "vector")) { .Data <- as.vector(object) attr(.Data, "class") <- NULL attrNames <- c("comment", "dim", "dimnames", "names", "row.names", "tsp") for (nm in names(value)[names(value) %in% attrNames]) attr(.Data, nm) <- value[[nm]] value <- value[!names(value) %in% attrNames] value$.Data <- .Data } value } # Taken from BiocGenerics 2.16 updateObjectFromSlots <- function (object, objclass = class(object), ..., verbose = FALSE) { updateObject <- nmfObject if (is(object, "environment")) { if (verbose) message("returning original object of class 'environment'") return(object) } classSlots <- slotNames(objclass) if (is.null(classSlots)) { if (verbose) message("definition of '", objclass, "' has no slots; ", "returning original object") return(object) } errf <- function(...) { function(err) { if (verbose) message(..., ":\n ", conditionMessage(err), "\n trying next method...") NULL } } if (verbose) message("updateObjectFromSlots(object = '", class(object), "' class = '", objclass, "')") objectSlots <- getObjectSlots(object) nulls <- sapply(names(objectSlots), function(slt) is.null(slot(object, slt))) objectSlots[nulls] <- NULL joint <- intersect(names(objectSlots), classSlots) toUpdate <- joint[joint != ".Data"] objectSlots[toUpdate] <- lapply(objectSlots[toUpdate], updateObject, ..., verbose = verbose) toDrop <- which(!names(objectSlots) %in% classSlots) if (length(toDrop) > 0L) { warning("dropping slot(s) ", paste(names(objectSlots)[toDrop], collapse = ", "), " from object = '", class(object), "'") objectSlots <- objectSlots[-toDrop] } res <- NULL if (is.null(res)) { if (verbose) message("heuristic updateObjectFromSlots, method 1") res <- tryCatch({ do.call(new, c(objclass, objectSlots[joint])) }, error = errf("'new(\"", objclass, "\", ...)' from slots failed")) } if (is.null(res)) { if (verbose) message("heuristic updateObjectFromSlots, method 2") res <- tryCatch({ obj <- do.call(new, list(objclass)) for (slt in joint) slot(obj, slt) <- updateObject(objectSlots[[slt]], ..., verbose = verbose) obj }, error = errf("failed to add slots to 'new(\"", objclass, "\", ...)'")) } if (is.null(res)) stop("could not updateObject to class '", objclass, "'", "\nconsider defining an 'updateObject' method for class '", class(object), "'") res } #' Updating NMF Objects #' #' This function serves to update an objects created with previous versions of the #' NMF package, which would otherwise be incompatible with the current version, #' due to changes in their S4 class definition. #' #' This function makes use of heuristics to automatically update object slots, #' which have been borrowed from the BiocGenerics package, the function #' \code{updateObjectFromSlots} in particular. #' #' @param object an R object created by the NMF package, e.g., an object of class #' \code{\linkS4class{NMF}} or \code{\linkS4class{NMFfit}}. #' @param verbose logical to toggle verbose messages. #' #' @export #' nmfObject <- function(object, verbose=FALSE){ objectUpdater(object, verbose=verbose) } NMF/R/NMFSet-class.R0000644000176000001440000017270412305630424013457 0ustar ripleyusers#' @include NMFfit-class.R #' @include heatmaps.R NULL #' \code{isNMFfit} tells if an object results from an NMF fit. #' #' @details \emph{isNMFfit} checks if \code{object} inherits from class #' \code{\linkS4class{NMFfit}} or \code{\linkS4class{NMFfitX}}, which are #' the two types of objects returned by the function \code{\link{nmf}}. #' If \code{object} is a plain \code{list} and \code{recursive=TRUE}, then #' the test is performed on each element of the list, and the return value #' is a logical vector (or a list if \code{object} is a list of list) of #' the same length as \code{object}. #' #' @export #' @rdname types #' @param object any R object. #' @param recursive if \code{TRUE} and \code{object} is a plain list then #' \code{isNMFfit} tests each element of the list. #' Note that the recursive test only applies in the case of lists that are #' not themselves NMFfit objects, like \code{NMFfitXn} objects for which #' the result of \code{isNMFfit} will always be \code{TRUE}, although they are #' list objects (a single logical value). #' #' @return \code{isNMFfit} returns a \code{logical} vector (or a list if #' \code{object} is a list of list) of the same length as \code{object}. #' #' @seealso \code{\linkS4class{NMFfit}}, \code{\linkS4class{NMFfitX}}, #' \code{\linkS4class{NMFfitXn}} #' @examples #' #' ## Testing results of fits #' # generate a random #' V <- rmatrix(20, 10) #' #' # single run -- using very low value for maxIter to speed up the example #' res <- nmf(V, 3, maxIter=3L) #' isNMFfit(res) #' #' # multiple runs - keeping single fit #' resm <- nmf(V, 3, nrun=3, maxIter=3L) #' isNMFfit(resm) #' #' # multiple runs - keeping all fits #' resM <- nmf(V, 3, nrun=3, .opt='k', maxIter=3L) #' isNMFfit(resM) #' #' # with a list of results #' isNMFfit(list(res, resm, resM, 'not a result')) #' isNMFfit(list(res, list(resm, resM), 'not a result')) # list of list #' isNMFfit(list(res, resm, resM, 'not a result'), recursive=FALSE) #' isNMFfit <- function(object, recursive=TRUE){ res <- is(object, 'NMFfit') || is(object, 'NMFfitX') # if the object is not a NMF result: apply to each element if a list (only in recursive mode) if( !res && recursive && is.list(object) ) sapply(object, isNMFfit) else res } #' Class for Storing Heterogeneous NMF fits #' #' @description #' This class wraps a list of NMF fit objects, which may come from different #' runs of the function \code{\link{nmf}}, using different parameters, methods, etc.. #' These can be either from a single run (NMFfit) or multiple runs (NMFfitX). #' #' Note that its definition/interface is very likely to change in the future. #' @export #' setClass('NMFList' , representation( runtime='proc_time' ) , contains='namedList' , validity=function(object){ # the list must only contains NMFfit objects of the same dimensions ok <- isNMFfit(object) if( !is.logical(ok) ) return("Could not validate elements in list: input is probably a complex structure of lists.") pb <- which(!ok) if( length(pb) ){ return(paste("invalid class for element(s)" , str_out(i) , "of input list [all elements must be fitted NMF models]")) } } ) #' Show method for objects of class \code{NMFList} #' @export setMethod('show', 'NMFList', function(object) { cat("\n") cat("Length:", length(object), "\n") if( length(object) > 0 ) cat("Method(s):", algorithm(object, string=TRUE), "\n") # show totaltime if present tt <- runtime(object) if( length(tt) > 0 ){ cat("Total timing:\n"); show(tt); } } ) #' Returns the method names used to compute the NMF fits in the list. #' It returns \code{NULL} if the list is empty. #' #' @param string a logical that indicate whether the names should be collapsed #' into a comma-separated string. #' @param unique a logical that indicates whether the result should contain the #' set of method names, removing duplicated names. #' This argument is forced to \code{TRUE} when \code{string=TRUE}. #' setMethod('algorithm', 'NMFList', function(object, string=FALSE, unique=TRUE){ l <- length(object) if( string ) unique <- TRUE if( l == 0 ) NULL else if( l == 1 ) algorithm(object[[1]]) else{ # build the vector of the algorithm names (with no repeat) m <- sapply(object, algorithm) if( unique ) m <- unique(m) if( string ) m <- paste(m, collapse=', ') m } } ) .seqtime <- function(object){ if( length(object) == 0 ) return(NULL) # sum up the time across the runs t.mat <- sapply(object, function(x){ if( is(x, 'NMFfitXn') ) runtime.all(x) else runtime(x) }) res <- rowSums(t.mat) class(res) <- 'proc_time' res } #' Returns the CPU time that would be required to sequentially compute all NMF #' fits stored in \code{object}. #' #' This method calls the function \code{runtime} on each fit and sum up the #' results. #' It returns \code{NULL} on an empty object. setMethod('seqtime', 'NMFList', function(object){ if( length(object) == 0 ) return(NULL) # sum up the time across the runs .seqtime(object) } ) #' Returns the CPU time required to compute all NMF fits in the list. #' It returns \code{NULL} if the list is empty. #' If no timing data are available, the sequential time is returned. #' #' @param all logical that indicates if the CPU time of each fit should be #' returned (\code{TRUE}) or only the total CPU time used to compute all #' the fits in \code{object}. setMethod('runtime', 'NMFList', function(object, all=FALSE){ if( !all ){ t <- slot(object, 'runtime') if( length(t)==0 ) seqtime(object) else t }else sapply(object, runtime) } ) as.NMFList <- function(..., unlist=FALSE){ arg.l <- list(...) if( length(arg.l) == 1L && is.list(arg.l[[1]]) && !is(arg.l[[1]], 'NMFfitX') ) arg.l <- arg.l[[1]] # unlist if required if( unlist ) arg.l <- unlist(arg.l) # create a NMFList object from the input list new('NMFList', arg.l) } #' Virtual Class to Handle Results from Multiple Runs of NMF Algorithms #' #' This class defines a common interface to handle the results from multiple #' runs of a single NMF algorithm, performed with the \code{\link{nmf}} method. #' #' Currently, this interface is implemented by two classes, #' \code{\linkS4class{NMFfitX1}} and \code{\linkS4class{NMFfitXn}}, which #' respectively handle the case where only the best fit is kept, and the case #' where the list of all the fits is returned. #' #' See \code{\link{nmf}} for more details on the method arguments. #' #' @slot runtime.all Object of class \code{\link[=proc.time]{proc_time}} that #' contains CPU times required to perform all the runs. #' #' @export #' @family multipleNMF #' @examples #' #' # generate a synthetic dataset with known classes #' n <- 20; counts <- c(5, 2, 3); #' V <- syntheticNMF(n, counts) #' #' # perform multiple runs of one algorithm (default is to keep only best fit) #' res <- nmf(V, 3, nrun=3) #' res #' #' # plot a heatmap of the consensus matrix #' \dontrun{ consensusmap(res) } #' #' # perform multiple runs of one algorithm (keep all the fits) #' res <- nmf(V, 3, nrun=3, .options='k') #' res #' setClass('NMFfitX' , representation( runtime.all = 'proc_time' # running time to perform all the NMF runs ) , contains='VIRTUAL' ) #' Returns the CPU time required to compute all the NMF runs. #' It returns \code{NULL} if no CPU data is available. setMethod('runtime.all', 'NMFfitX', function(object){ t <- slot(object, 'runtime.all') if( length(t) > 0 ) t else NULL } ) #' Returns the number of NMF runs performed to create \code{object}. #' #' It is a pure virtual method defined to ensure \code{nrun} is defined #' for sub-classes of \code{NMFfitX}, which throws an error if called. #' #' Note that because the \code{\link{nmf}} function allows to run the NMF #' computation keeping only the best fit, \code{nrun} may return a value #' greater than one, while only the result of the best run is stored in #' the object (cf. option \code{'k'} in method \code{\link{nmf}}). setMethod('nrun', 'NMFfitX', function(object){ stop("NMF::NMFfitX - missing definition for pure virtual method 'nrun' in class '", class(object), "'") } ) #' This method always returns 1, since an \code{NMFfit} object is obtained #' from a single NMF run. setMethod('nrun', 'NMFfit', function(object){ 1L } ) #' \code{consensus} is an S4 generic that computes/returns the consensus matrix #' from a model object, which is the mean connectivity matrix of all the runs. #' #' The consensus matrix has been proposed by \cite{Brunet2004} to help #' visualising and measuring the stability of the clusters obtained by #' NMF approaches. #' For objects of class \code{NMF} (e.g. results of a single NMF run, or NMF #' models), the consensus matrix reduces to the connectivity matrix. #' #' @rdname connectivity #' @export setGeneric('consensus', function(object, ...) standardGeneric('consensus') ) #' Pure virtual method defined to ensure \code{consensus} is defined for sub-classes of \code{NMFfitX}. #' It throws an error if called. setMethod('consensus', 'NMFfitX', function(object, ...){ stop("NMF::NMFfitX - missing definition for pure virtual method 'consensus' in class '", class(object), "'") } ) #' This method is provided for completeness and is identical to #' \code{\link{connectivity}}, and returns the connectivity matrix, #' which, in the case of a single NMF model, is also the consensus matrix. setMethod('consensus', 'NMF', function(object, ...){ connectivity(object, ...) } ) #' Hierarchical Clustering of a Consensus Matrix #' #' The function \code{consensushc} computes the hierarchical clustering of #' a consensus matrix, using the matrix itself as a similarity matrix and #' average linkage. #' It is #' #' @param object a matrix or an \code{NMFfitX} object, as returned by multiple #' NMF runs. #' @param ... extra arguments passed to next method calls #' #' @return an object of class \code{dendrogram} or \code{hclust} depending on the #' value of argument \code{dendrogram}. #' #' @inline #' @export setGeneric('consensushc', function(object, ...) standardGeneric('consensushc')) #' Workhorse method for matrices. #' #' @param method linkage method passed to \code{\link{hclust}}. #' @param dendrogram a logical that specifies if the result of the hierarchical #' clustering (en \code{hclust} object) should be converted into a dendrogram. #' Default value is \code{TRUE}. setMethod('consensushc', 'matrix', function(object, method='average', dendrogram=TRUE){ # hierachical clustering based on the connectivity matrix hc <- hclust(as.dist(1-object), method=method) # convert into a dendrogram if requested if( dendrogram ) as.dendrogram(hc) else hc } ) #' Compute the hierarchical clustering on the connectivity matrix of \code{object}. setMethod('consensushc', 'NMF', function(object, ...){ # hierachical clustering based on the connectivity matrix consensushc(connectivity(object), ...) } ) #' Compute the hierarchical clustering on the consensus matrix of \code{object}, #' or on the connectivity matrix of the best fit in \code{object}. #' #' @param what character string that indicates which matrix to use in the #' computation. #' setMethod('consensushc', 'NMFfitX', function(object, what=c('consensus', 'fit'), ...){ what <- match.arg(what) if( what == 'consensus' ){ # hierachical clustering on the consensus matrix consensushc(consensus(object), ...) }else if( what == 'fit' ) consensushc(fit(object), ...) } ) #' Returns the cluster membership index from an NMF model fitted with multiple #' runs. #' #' Besides the type of clustering available for any NMF models #' (\code{'columns', 'rows', 'samples', 'features'}), this method can return #' the cluster membership index based on the consensus matrix, computed from #' the multiple NMF runs. #' #' Argument \code{what} accepts the following extra types: #' \describe{ #' \item{\code{'chc'}}{ returns the cluster membership based on the #' hierarchical clustering of the consensus matrix, as performed by #' \code{\link{consensushc}}.} #' \item{\code{'consensus'}}{ same as \code{'chc'} but the levels of the membership #' index are re-labeled to match the order of the clusters as they would be displayed on the #' associated dendrogram, as re-ordered on the default annotation track in consensus #' heatmap produced by \code{\link{consensusmap}}.} #' } #' setMethod('predict', signature(object='NMFfitX'), function(object, what=c('columns', 'rows', 'samples', 'features', 'consensus', 'chc'), dmatrix = FALSE, ...){ # determine which prediction to do what <- match.arg(what) res <- if( what %in% c('consensus', 'chc') ){ # build the tree from consensus matrix h <- consensushc(object, what='consensus', dendrogram=FALSE) # extract membership from the tree cl <- cutree(h, k=nbasis(object)) # rename the cluster ids in the case of a consensus map if( what != 'chc' ){ dr <- as.dendrogram(h) o <- order.dendrogram(reorder(dr, rowMeans(consensus(object), na.rm=TRUE))) cl <- setNames(match(cl, unique(cl[o])), names(cl)) } res <- as.factor(cl) # add dissimilarity matrix if requested if( dmatrix ){ attr(res, 'dmatrix') <- 1 - consensus(object) } if( what != 'chc' ) attr(res, 'iOrd') <- o # return res } else predict(fit(object), what=what, ..., dmatrix = dmatrix) attr(res, 'what') <- what res } ) #' Returns the model object that achieves the lowest residual approximation #' error across all the runs. #' #' It is a pure virtual method defined to ensure \code{fit} is defined #' for sub-classes of \code{NMFfitX}, which throws an error if called. setMethod('fit', 'NMFfitX', function(object){ stop("NMF::NMFfitX - missing definition for pure virtual method 'fit' in class '", class(object), "'") } ) #' Returns the fit object that achieves the lowest residual approximation #' error across all the runs. #' #' It is a pure virtual method defined to ensure \code{minfit} is defined #' for sub-classes of \code{NMFfitX}, which throws an error if called. setMethod('minfit', 'NMFfitX', function(object){ stop("NMF::NMFfitX - missing definition for pure virtual method 'minfit' in class '", class(object), "'") } ) #' Show method for objects of class \code{NMFfitX} #' @export setMethod('show', 'NMFfitX', function(object){ cat("\n") # name of the algorithm cat(" Method:", algorithm(object), "\n") # number of runs cat(" Runs: ", nrun(object),"\n"); # initial state cat(" RNG:\n ", RNGstr(getRNG1(object)),"\n"); if( nrun(object) > 0 ){ # show total timing cat(" Total timing:\n"); show(runtime.all(object)); } } ) #' Extracting RNG Data from NMF Objects #' #' The \code{\link{nmf}} function returns objects that contain embedded RNG data, #' that can be used to exactly reproduce any computation. #' These data can be extracted using dedicated methods for the S4 generics #' \code{\link[rngtools]{getRNG}} and \code{\link[rngtools]{getRNG1}}. #' #' @inheritParams rngtools::getRNG #' @inheritParams rngtools::getRNG1 #' #' @inline #' @rdname RNG #' @export setGeneric('getRNG1', package='rngtools') #' Returns the RNG settings used for the first NMF run of multiple NMF runs. #' #' @examples #' # For multiple NMF runs, the RNG settings used for the first run is also stored #' V <- rmatrix(20,10) #' res <- nmf(V, 3, nrun=4) #' # RNG used for the best fit #' getRNG(res) #' # RNG used for the first of all fits #' getRNG1(res) #' # they may differ if the best fit is not the first one #' rng.equal(res, getRNG1(res)) #' setMethod('getRNG1', signature(object='NMFfitX'), function(object){ stop("NMF::getRNG1(", class(object), ") - Unimplemented pure virtual method: could not extract initial RNG settings.") } ) #' Compares two NMF models when at least one comes from multiple NMF runs. setMethod('nmf.equal', signature(x='NMFfitX', y='NMF'), function(x, y, ...){ nmf.equal(fit(x), y, ...) } ) #' Compares two NMF models when at least one comes from multiple NMF runs. setMethod('nmf.equal', signature(x='NMF', y='NMFfitX'), function(x, y, ...){ nmf.equal(x, fit(y), ...) } ) #' Returns the residuals achieved by the best fit object, i.e. the lowest #' residual approximation error achieved across all NMF runs. setMethod('residuals', signature(object='NMFfitX'), function(object, ...){ residuals(minfit(object), ...) } ) #' Returns the deviance achieved by the best fit object, i.e. the lowest #' deviance achieved across all NMF runs. setMethod('deviance', signature(object='NMFfitX'), function(object, ...){ deviance(minfit(object), ...) } ) ######################################################### # END_NMFfitX ######################################################### #' Structure for Storing the Best Fit Amongst Multiple NMF Runs #' #' This class is used to return the result from a multiple run of a single NMF #' algorithm performed with function \code{nmf} with the -- default -- option #' \code{keep.all=FALSE} (cf. \code{\link{nmf}}). #' #' It extends both classes \code{\linkS4class{NMFfitX}} and #' \code{\linkS4class{NMFfit}}, and stores a the result of the best fit in its #' \code{NMFfit} structure. #' #' Beside the best fit, this class allows to hold data about the computation of #' the multiple runs, such as the number of runs, the CPU time used to perform #' all the runs, as well as the consensus matrix. #' #' Due to the inheritance from class \code{NMFfit}, objects of class #' \code{NMFfitX1} can be handled exactly as the results of single NMF run -- #' as if only the best run had been performed. #' #' #' @slot consensus object of class \code{matrix} used to store the #' consensus matrix based on all the runs. #' #' @slot nrun an \code{integer} that contains the number of runs #' performed to compute the object. #' #' @slot rng1 an object that contains RNG settings used for the first #' run. See \code{\link{getRNG1}}. #' #' @export #' @family multipleNMF #' @examples #' #' # generate a synthetic dataset with known classes #' n <- 20; counts <- c(5, 2, 3); #' V <- syntheticNMF(n, counts) #' #' # get the class factor #' groups <- V$pData$Group #' #' # perform multiple runs of one algorithm, keeping only the best fit (default) #' #i.e.: the implicit nmf options are .options=list(keep.all=FALSE) or .options='-k' #' res <- nmf(V, 3, nrun=3) #' res #' #' # compute summary measures #' summary(res) #' # get more info #' summary(res, target=V, class=groups) #' #' # show computational time #' runtime.all(res) #' #' # plot the consensus matrix, as stored (pre-computed) in the object #' \dontrun{ consensusmap(res, annCol=groups) } #' setClass('NMFfitX1' , representation( #fit = 'NMFfit' # holds the best fit from all the runs consensus = 'matrix' # average connectivity matrix of all the NMF runs , nrun = 'integer' , rng1 = 'ANY' ) , contains=c('NMFfitX', 'NMFfit') , prototype=prototype( consensus = matrix(as.numeric(NA),0,0) , nrun = as.integer(0) ) ) #' Show method for objects of class \code{NMFfitX1} #' @export setMethod('show', 'NMFfitX1', function(object){ callNextMethod(object) # show details of the best fit #cat(" # Best fit:\n ") #s <- capture.output(show(fit(object))) #cat(s, sep="\n |") } ) #' Returns the number of NMF runs performed, amongst which \code{object} was #' selected as the best fit. setMethod('nrun', 'NMFfitX1', function(object){ slot(object,'nrun') } ) #' Returns the consensus matrix computed while performing all NMF runs, #' amongst which \code{object} was selected as the best fit. #' #' The result is the matrix stored in slot \sQuote{consensus}. #' This method returns \code{NULL} if the consensus matrix is empty. setMethod('consensus', signature(object='NMFfitX1'), function(object, no.attrib = FALSE){ C <- slot(object, 'consensus') if( length(C) > 0 ){ if( !no.attrib ){ class(C) <- c(class(C), 'NMF.consensus') attr(C, 'nrun') <- nrun(object) attr(C, 'nbasis') <- nbasis(object) } C }else NULL } ) #' Returns the fit object associated with the best fit, amongst all the #' runs performed when fitting \code{object}. #' #' Since \code{NMFfitX1} objects only hold the best fit, this method simply #' returns \code{object} coerced into an \code{NMFfit} object. setMethod('minfit', 'NMFfitX1', function(object){ # coerce the object into a NMFfit object as(object, 'NMFfit') } ) #' Returns the model object associated with the best fit, amongst all the #' runs performed when fitting \code{object}. #' #' Since \code{NMFfitX1} objects only hold the best fit, this method simply #' returns the NMF model fitted by \code{object} -- that is stored in slot #' \sQuote{fit}. setMethod('fit', signature(object='NMFfitX1'), function(object){ slot(object, 'fit') } ) #' Returns the RNG settings used to compute the first of all NMF runs, amongst #' which \code{object} was selected as the best fit. setMethod('getRNG1', signature(object='NMFfitX1'), function(object){ object@rng1 } ) #' Compares the NMF models fitted by multiple runs, that only kept the best fits. setMethod('nmf.equal', signature(x='NMFfitX1', y='NMFfitX1'), function(x, y, ...){ nmf.equal(fit(x), fit(y), ...) } ) ######################################################### # END_NMFfitX1 ######################################################### #' Structure for Storing All Fits from Multiple NMF Runs #' #' This class is used to return the result from a multiple run of a single NMF #' algorithm performed with function \code{nmf} with option #' \code{keep.all=TRUE} (cf. \code{\link{nmf}}). #' #' It extends both classes \code{\linkS4class{NMFfitX}} and \code{list}, and #' stores the result of each run (i.e. a \code{NMFfit} object) in its #' \code{list} structure. #' #' IMPORTANT NOTE: This class is designed to be \strong{read-only}, even though #' all the \code{list}-methods can be used on its instances. Adding or removing #' elements would most probably lead to incorrect results in subsequent calls. #' Capability for concatenating and merging NMF results is for the moment only #' used internally, and should be included and supported in the next release of #' the package. #' #' #' @slot .Data standard slot that contains the S3 \code{list} object data. #' See R documentation on S3/S4 classes for more details (e.g., \code{\link{setOldClass}}). #' #' @export #' @family multipleNMF #' @examples #' #' # generate a synthetic dataset with known classes #' n <- 20; counts <- c(5, 2, 3); #' V <- syntheticNMF(n, counts) #' #' # get the class factor #' groups <- V$pData$Group #' #' # perform multiple runs of one algorithm, keeping all the fits #' res <- nmf(V, 3, nrun=3, .options='k') # .options=list(keep.all=TRUE) also works #' res #' #' summary(res) #' # get more info #' summary(res, target=V, class=groups) #' #' # compute/show computational times #' runtime.all(res) #' seqtime(res) #' #' # plot the consensus matrix, computed on the fly #' \dontrun{ consensusmap(res, annCol=groups) } #' setClass('NMFfitXn' , contains=c('NMFfitX', 'list') , validity=function(object){ # the list must only contains NMFfit objects of the same dimensions ref.dim <- NULL ref.algo <- NULL for(i in seq_along(object)){ # check class of the element item <- object[[i]] if( !(is(item, 'NMFfit') && !is(item, 'NMFfitX')) ) return(paste("invalid class for element", i, "of input list [all elements must be a NMFfit object]")) # check dimensions if( is.null(ref.dim) ) ref.dim <- dim(item) if( !identical(ref.dim, dim(item)) ) return(paste("invalid dimension for element", i, "of input list [all elements must have the same dimensions]")) # check algorithm names if( is.null(ref.algo) ) ref.algo <- algorithm(item) if( !identical(ref.algo, algorithm(item)) ) return(paste("invalid algorithm for element", i, "of input list [all elements must result from the same algorithm]")) } } ) # Updater for slot .Data #objectUpdater('NMFfitXn', '0.5.06' # , vfun=function(object){ !.hasSlot(object, 'rng1') } # , function(x, y){ # y@.Data <- lapply(x@.Data, nmfObject) # } #) #' Show method for objects of class \code{NMFfitXn} #' @export setMethod('show', 'NMFfitXn', function(object){ callNextMethod(object) # if the object is not empty and slot runtime.all is not null then show # the sequential time, as it might be different from runtime.all if( length(object) > 0 && !is.null(runtime.all(object, null=TRUE)) ){ # show total sequential timing cat(" Sequential timing:\n"); show(seqtime(object)); } } ) #' Returns the number of basis components common to all fits. #' #' Since all fits have been computed using the same rank, it returns the #' factorization rank of the first fit. #' This method returns \code{NULL} if the object is empty. setMethod('nbasis', signature(x='NMFfitXn'), function(x, ...){ if( length(x) == 0 ) return(NULL) return( nbasis(x[[1]]) ) } ) #' Returns the dimension common to all fits. #' #' Since all fits have the same dimensions, it returns the dimension of the #' first fit. #' This method returns \code{NULL} if the object is empty. #' #' @rdname dims setMethod('dim', signature(x='NMFfitXn'), function(x){ if( length(x) == 0 ) return(NULL) return( dim(x[[1L]]) ) } ) #' Returns the coefficient matrix of the best fit amongst all the fits stored in #' \code{object}. #' It is a shortcut for \code{coef(fit(object))}. setMethod('coef', signature(object='NMFfitXn'), function(object, ...){ coef(fit(object), ...) } ) #' Returns the basis matrix of the best fit amongst all the fits stored in #' \code{object}. #' It is a shortcut for \code{basis(fit(object))}. setMethod('basis', signature(object='NMFfitXn'), function(object, ...){ basis(fit(object), ...) } ) #' Method for multiple NMF fit objects, which returns the indexes of fixed basis #' terms from the best fitted model. setMethod('ibterms', 'NMFfitX', function(object){ ibterms(fit(object)) } ) #' Method for multiple NMF fit objects, which returns the indexes of fixed #' coefficient terms from the best fitted model. setMethod('icterms', 'NMFfit', function(object){ icterms(fit(object)) } ) #' Returns the number of runs performed to compute the fits stored in the list #' (i.e. the length of the list itself). setMethod('nrun', 'NMFfitXn', function(object){ length(object) } ) #' Returns the name of the common NMF algorithm used to compute all fits #' stored in \code{object} #' #' Since all fits are computed with the same algorithm, this method returns the #' name of algorithm that computed the first fit. #' It returns \code{NULL} if the object is empty. setMethod('algorithm', 'NMFfitXn', function(object){ if( length(object) == 0 ) return(NULL) return( algorithm(object[[1]]) ) } ) #' Returns the name of the common seeding method used the computation of all fits #' stored in \code{object} #' #' Since all fits are seeded using the same method, this method returns the #' name of the seeding method used for the first fit. #' It returns \code{NULL} if the object is empty. setMethod('seeding', 'NMFfitXn', function(object){ if( length(object) == 0 ) return(NULL) return( seeding(object[[1]]) ) } ) #' Returns the common type NMF model of all fits stored in \code{object} #' #' Since all fits are from the same NMF model, this method returns the #' model type of the first fit. #' It returns \code{NULL} if the object is empty. setMethod('modelname', signature(object='NMFfitXn'), function(object){ if( length(object) == 0 ) return(NULL) return( modelname(object[[1]]) ) } ) #' Returns the CPU time that would be required to sequentially compute all NMF #' fits stored in \code{object}. #' #' This method calls the function \code{runtime} on each fit and sum up the #' results. #' It returns \code{NULL} on an empty object. setMethod('seqtime', 'NMFfitXn', function(object){ if( length(object) == 0 ) return(NULL) # sum up the time across the runs .seqtime(object) } ) #' Returns the CPU time used to perform all the NMF fits stored in \code{object}. #' #' If no time data is available from in slot \sQuote{runtime.all} and argument #' \code{null=TRUE}, then the sequential time as computed by #' \code{\link{seqtime}} is returned, and a warning is thrown unless \code{warning=FALSE}. #' #' @param null a logical that indicates if the sequential time should be returned #' if no time data is available in slot \sQuote{runtime.all}. #' @param warning a logical that indicates if a warning should be thrown if the #' sequential time is returned instead of the real CPU time. #' setMethod('runtime.all', 'NMFfitXn', function(object, null=FALSE, warning=TRUE){ if( length(object) == 0 ) return(NULL) stored.time <- slot(object, 'runtime.all') # if there is some time stored, return it if( length(stored.time) > 0 ) stored.time else if( null ) NULL else{ if( warning ) warning("NMFfitXn::runtime.all - computation time data not available [sequential time was used instead]") seqtime(object) # otherwise total sequential time } } ) #' Returns the best NMF model in the list, i.e. the run that achieved the lower #' estimation residuals. #' #' The model is selected based on its \code{deviance} value. #' setMethod('minfit', 'NMFfitXn', function(object){ b <- which.best(object, deviance) # test for length 0 if( length(b) == 0 ) return(NULL) # return the run with the lower object[[ b ]] } ) #' \code{which.best} returns the index of the best fit in a list of NMF fit, #' according to some quantitative measure. #' The index of the fit with the lowest measure is returned. #' #' @param object an NMF model fitted by multiple runs. #' @param FUN the function that computes the quantitative measure. #' @param ... extra arguments passed to \code{FUN}. #' #' @export #' @rdname advanced which.best <- function(object, FUN=deviance, ...){ # test for length 0 if( length(object) == 0 ) return(integer()) # retrieve the measure for each run e <- sapply(object, FUN, ...) # return the run with the lower which.min(e) } #' Returns the RNG settings used for the first run. #' #' This method throws an error if the object is empty. setMethod('getRNG1', signature(object='NMFfitXn'), function(object){ if( length(object) == 0 ) stop("NMF::getRNG1 - Could not extract RNG data from empty object [class:", class(object), "]") getRNG(object[[1]]) } ) #' @inline #' @rdname RNG #' @export setGeneric('.getRNG', package='rngtools') #' Returns the RNG settings used for the best fit. #' #' This method throws an error if the object is empty. setMethod('.getRNG', signature(object='NMFfitXn'), function(object, ...){ if( length(object) == 0 ) stop("NMF::getRNG - Could not extract RNG data from empty object [class:", class(object), "]") getRNG(minfit(object), ...) } ) #' Returns the best NMF fit object amongst all the fits stored in \code{object}, #' i.e. the fit that achieves the lowest estimation residuals. setMethod('fit', signature(object='NMFfitXn'), function(object){ fit( minfit(object) ) } ) #' Compares the results of multiple NMF runs. #' #' This method either compare the two best fit, or all fits separately. #' All extra arguments in \code{...} are passed to each internal call to #' \code{nmf.equal}. #' #' @param all a logical that indicates if all fits should be compared separately #' or only the best fits #' @param vector a logical, only used when \code{all=TRUE}, that indicates if #' all fits must be equal for \code{x} and \code{y} to be declared equal, or #' if one wants to return the result of each comparison in a vector. #' #' @inline setMethod('nmf.equal', signature(x='list', y='list'), function(x, y, ..., all=FALSE, vector=FALSE){ if( !all ) nmf.equal(x[[ which.best(x) ]], y[[ which.best(y) ]], ...) else{ if( length(x) != length(y) ) FALSE else res <- mapply(function(a,b,...) isTRUE(nmf.equal(a,b,...)), x, y, MoreArgs=list(...)) if( !vector ) res <- all( res ) res } } ) #' Compare all elements in \code{x} to \code{x[[1]]}. setMethod('nmf.equal', signature(x='list', y='missing'), function(x, y, ...){ if( length(x) == 0L ){ warning("Empty list argument `x`: returning NA") return(NA) } if( length(x) == 1L ){ warning("Only one element in list argument `x`: returning TRUE") return(TRUE) } for( a in x ){ if( !nmf.equal(x[[1]], a, ...) ) return(FALSE) } return(TRUE) } ) #' Computes the consensus matrix of the set of fits stored in \code{object}, as #' the mean connectivity matrix across runs. #' #' This method returns \code{NULL} on an empty object. #' The result is a matrix with several attributes attached, that are used by #' plotting functions such as \code{\link{consensusmap}} to annotate the plots. #' #' @aliases plot.NMF.consensus setMethod('consensus', signature(object='NMFfitXn'), function(object, ..., no.attrib = FALSE){ if( length(object) == 0 ) return(NULL) # init empty consensus matrix con <- matrix(0, ncol(object), ncol(object)) # name the rows and columns appropriately: use the sample names of the first fit dimnames(con) <- list(colnames(object[[1]]), colnames(object[[1]])) # compute mean connectivity matrix sapply(object , function(x, ...){ con <<- con + connectivity(x, ..., no.attrib = TRUE) NULL } , ... ) con <- con / nrun(object) # return result if( !no.attrib ){ class(con) <- c(class(con), 'NMF.consensus') attr(con, 'nrun') <- nrun(object) attr(con, 'nbasis') <- nbasis(object) } con } ) #' @S3method plot NMF.consensus plot.NMF.consensus <- function(x, ...){ consensusmap(x, ...) } #' Dispersion of a Matrix #' #' Computes the dispersion coefficient of a -- consensus -- matrix #' \code{object}, generally obtained from multiple NMF runs. #' #' The dispersion coefficient is based on the consensus matrix (i.e. the #' average of connectivity matrices) and was proposed by \cite{KimH2007} to #' measure the reproducibility of the clusters obtained from NMF. #' #' It is defined as: #' \deqn{\rho = \sum_{i,j=1}^n 4 (C_{ij} - \frac{1}{2})^2 , } #' where \eqn{n} is the total number of samples. #' #' By construction, \eqn{0 \leq \rho \leq 1} and \eqn{\rho = 1} only for a perfect #' consensus matrix, where all entries 0 or 1. #' A perfect consensus matrix is obtained only when all the connectivity matrices #' are the same, meaning that the algorithm gave the same clusters at each run. #' See \cite{KimH2007}. #' #' @param object an object from which the dispersion is computed #' @param ... extra arguments to allow extension #' #' @export setGeneric('dispersion', function(object, ...) standardGeneric('dispersion') ) #' Workhorse method that computes the dispersion on a given matrix. setMethod('dispersion', 'matrix', function(object, ...){ stopifnot( nrow(object) == ncol(object) ) sum( 4 * (object-1/2)^2 ) / nrow(object)^2 } ) #' Computes the dispersion on the consensus matrix obtained from multiple NMF #' runs. setMethod('dispersion', 'NMFfitX', function(object, ...){ dispersion(consensus(object), ...) } ) #' Factory Method for Multiple NMF Run Objects #' #' @param object an object from which is created an \code{NMFfitX} object #' @param ... extra arguments used to pass values for slots #' #' @inline #' @keywords internal setGeneric('NMFfitX', function(object, ...) standardGeneric('NMFfitX') ) #' Create an \code{NMFfitX} object from a list of fits. #' #' @param .merge a logical that indicates if the fits should be aggregated, only #' keeping the best fit, and return an \code{NMFfitX1} object. #' If \code{FALSE}, an \code{NMFfitXn} object containing the data of all the fits #' is returned. #' setMethod('NMFfitX', 'list', function(object, ..., .merge=FALSE){ if( length(object) == 0 ) return(new('NMFfitXn')) else if( is(object, 'NMFfitXn') && !.merge) return(object) # retrieve the extra arguments extra <- list(...) # if runtime.all is provided: be sure it's of the right class tt <- extra$runtime.all compute.tt <- TRUE if( !is.null(tt) ){ if( !is(tt, 'proc_time') ){ if( !is.numeric(tt) || length(tt) != 5 ) stop("NMF::NMFfitX - invalid value for 'runtime.all' [5-length numeric expected]") class(extra$runtime.all) <- 'proc_time' } compute.tt <- FALSE }else{ extra$runtime.all <- rep(0,5) class(extra$runtime.all) <- 'proc_time' } # check validity and aggregate if required ref.algo <- NULL ref.class <- NULL nrun <- 0 lapply( seq_along(object) , function(i){ item <- object[[i]] # check the type of each element if( !(is(item, 'NMFfitX') || is(item, 'NMFfit')) ) stop("NMF::NMFfitX - invalid class for element ", i, " of input list [all elements must be NMFfit or NMFfitX objects]") # check that all elements result from the same algorithm if( is.null(ref.algo) ) ref.algo <<- algorithm(item) if( !identical(algorithm(item), ref.algo) ) stop("NMF::NMFfitX - invalid algorithm for element ", i, " of input list [cannot join results from different algorithms]") # check if simple join is possible: only Ok if all elements are from the same class (NMFfit or NMFfitXn) if( length(ref.class) <= 1 ) ref.class <<- unique(c(ref.class, class(item))) # sum up the number of runs nrun <<- nrun + nrun(item) # compute total running time if necessary if( compute.tt ) extra$runtime.all <<- extra$runtime.all + runtime.all(item) } ) # force merging if the input list is hetergeneous or if it only contains NMFfitX1 objects if( length(ref.class) > 1 || ref.class == 'NMFfitX1' ){ nmf.debug('NMFfitX', ".merge is forced to TRUE") .merge <- TRUE } # unpack all the NMFfit objects object.list <- unlist(object) nmf.debug('NMFfitX', "Number of fits to join = ", length(object.list)) # one wants to keep only the best result if( .merge ){ warning("NMF::NMFfitX - The method for merging lists is still in development") # set the total number of runs extra$nrun <- as.integer(nrun) # consensus matrix if( !is.null(extra$consensus) ) warning("NMF::NMFfitX - the value of 'consensus' was discarded as slot 'consensus' is computed internally") extra$consensus <- NULL consensus <- matrix(as.numeric(NA), 0, 0) best.res <- Inf best.fit <- NULL sapply(object.list, function(x){ if( !is(x, 'NMFfit') ) stop("NMF::NMFfitX - all inner-elements of '",substitute(object),"' must inherit from class 'NMFfit'") # merge consensus matrices consensus <<- if( sum(dim(consensus)) == 0 ) nrun(x) * consensus(x) else consensus + nrun(x) * consensus(x) temp.res <- residuals(x) if( temp.res < best.res ){ # keep best result best.fit <<- minfit(x) best.res <<- temp.res } }) # finalize consensus matrix consensus <- consensus/extra$nrun extra$consensus <- consensus # return merged result return( do.call(NMFfitX, c(list(best.fit), extra)) ) } else{ # create a NMFfitXn object that holds the whole list do.call('new', c(list('NMFfitXn', object.list), extra)) } } ) #' Creates an \code{NMFfitX1} object from a single fit. #' This is used in \code{\link{nmf}} when only the best fit is kept in memory or #' on disk. #' setMethod('NMFfitX', 'NMFfit', function(object, ...){ extra <- list(...) # default value for nrun is 1 if( is.null(extra$nrun) ) extra$nrun = as.integer(1) # a consensus matrix is required (unless nrun is 1) if( is.null(extra$consensus) ){ if( extra$nrun == 1 ) extra$consensus <- connectivity(object) else stop("Slot 'consensus' is required to create a 'NMFfitX1' object where nrun > 1") } # slot runtime.all is inferred if missing and nrun is 1 if( is.null(extra$runtime.all) && extra$nrun == 1 ) extra$runtime.all <- runtime(object) # create the NMFfitX1 object do.call('new', c(list('NMFfitX1', object), extra)) } ) #' Provides a way to aggregate \code{NMFfitXn} objects into an \code{NMFfitX1} #' object. setMethod('NMFfitX', 'NMFfitX', function(object, ...){ # nothing to do in the case of NMFfitX1 objects if( is(object, 'NMFfitX1') ) return(object) # retrieve extra arguments extra <- list(...) # take runtime.all from the object itself if( !is.null(extra$runtime.all) ) warning("NMF::NMFfitX - argument 'runtime.all' was discarded as it is computed from argument 'object'") extra$runtime.all <- runtime.all(object) # create the NMFfitX1 object f <- selectMethod(NMFfitX, 'list') do.call(f, c(list(object), extra)) } ) #' Computes the best or mean purity across all NMF fits stored in \code{x}. #' #' @param method a character string that specifies how the value is computed. #' It may be either \code{'best'} or \code{'mean'} to compute the best or mean #' purity respectively. #' #' @inline setMethod('purity', signature(x='NMFfitXn', y='ANY'), function(x, y, method='best', ...){ c <- sapply(x, purity, y=y, ...) # aggregate the results if a method is provided if( is.null(method) ) c else aggregate.measure(c, method, decreasing=TRUE) } ) #' Computes the best or mean entropy across all NMF fits stored in \code{x}. #' #' @inline setMethod('entropy', signature(x='NMFfitXn', y='ANY'), function(x, y, method='best', ...){ c <- sapply(x, entropy, y=y, ...) # aggregate the results if a method is provided if( is.null(method) ) c else aggregate.measure(c, method) } ) ###% Utility function to aggregate numerical quality measures from \code{NMFfitXn} objects. ###% ###% Given a numerical vector, this function computes an aggregated value using one of the following methods: ###% - mean: the mean of the measures ###% - best: the best measure according to the specified sorting order (decreasing or not) ###% aggregate.measure <- function(measure, method=c('best', 'mean'), decreasing=FALSE){ # aggregate the results method <- match.arg(method) res <- switch(method , mean = mean(measure) , best = if( decreasing ) max(measure) else min(measure) ) # set the name to names(res) <- method # return result res } #' Computes a set of measures to help evaluate the quality of the \emph{best #' fit} of the set. #' The result is similar to the result from the \code{summary} method of #' \code{NMFfit} objects. #' See \code{\linkS4class{NMF}} for details on the computed measures. #' In addition, the cophenetic correlation (\code{\link{cophcor}}) and #' \code{\link{dispersion}} coefficients of the consensus matrix are returned, #' as well as the total CPU time (\code{\link{runtime.all}}). #' setMethod('summary', signature(object='NMFfitX'), function(object, ...){ # compute summary measures for the best fit best.fit <- minfit(object) s <- summary(best.fit, ...) # get totaltime t <- runtime.all(object) # replace cpu.all and nrun in the result (as these are set by the summary method of class NMFfit) s[c('cpu.all', 'nrun')] <- c(as.numeric(t['user.self']+t['user.child']), nrun(object)) # compute cophenetic correlation coeff and dispersion C <- consensus(object) s <- c(s, cophenetic=cophcor(C), dispersion=dispersion(C)) # compute mean consensus silhouette width si <- silhouette(object, what = 'consensus') s <- c(s, silhouette.consensus = if( !is_NA(si) ) summary(si)$avg.width else NA) # return result s } ) #' Comparing Results from Different NMF Runs #' #' The functions documented here allow to compare the fits computed in #' different NMF runs. #' The fits do not need to be from the same algorithm, nor have the same #' dimension. #' #' The methods \code{compare} enables to compare multiple NMF fits either #' passed as arguments or as a list of fits. #' These methods eventually call the method \code{summary,NMFList}, so that #' all its arguments can be passed \strong{named} in \code{...}. #' #' @param ... extra arguments passed by \code{compare} to \code{summary,NMFList} #' or to the \code{summary} method of each fit. #' #' @name compare-NMF #' @rdname nmf-compare NULL .compare_NMF <- function(...){ args <- list(...) iargs <- if( is.null(names(args)) ){ names(args) <- rep("", length(args)) seq(args) }else{ iargs <- which(names(args)=='') if( length(iargs) != length(args) ) iargs <- iargs[ iargs < which(names(args)!='')[1L] ] iargs } lfit <- args[iargs] lfit <- unlist(lfit, recursive=FALSE) # wrap up into an NMFList object object <- as.NMFList(lfit) do.call('summary', c(list(object), args[-iargs])) } #' Compare multiple NMF fits passed as arguments. #' #' @rdname nmf-compare #' #' @examples #' #' x <- rmatrix(20,10) #' res <- nmf(x, 3) #' res2 <- nmf(x, 2, 'lee') #' #' # compare arguments #' compare(res, res2, target=x) #' setMethod('compare', signature(object='NMFfit'), function(object, ...){ .compare_NMF(object, ...) } ) #' Compares the fits obtained by separate runs of NMF, in a single #' call to \code{\link{nmf}}. #' #' @rdname nmf-compare #' #' # compare each fits in a multiple runs #' res3 <- nmf(x, 2, nrun=3, .opt='k') #' compare(res3) #' compare(res3, res, res2) #' compare(list(res3), res, res2, target=x) #' setMethod('compare', signature(object='NMFfitXn'), function(object, ...){ do.call(.compare_NMF, c(unlist(object), list(...))) } ) #' Compares multiple NMF fits passed as a standard list. #' #' @rdname nmf-compare #' #' @examples #' # compare elements of a list #' compare(list(res, res2), target=x) setMethod('compare', signature(object='list'), function(object, ...){ do.call(.compare_NMF, c(list(object), list(...))) } ) #' @details #' \code{summary,NMFList} computes summary measures for each NMF result in the list #' and return them in rows in a \code{data.frame}. #' By default all the measures are included in the result, and \code{NA} values #' are used where no data is available or the measure does not apply to the #' result object (e.g. the dispersion for single' NMF runs is not meaningful). #' This method is very useful to compare and evaluate the performance of #' different algorithms. #' #' @param select the columns to be output in the result \code{data.frame}. The #' column are given by their names (partially matched). The column names are #' the names of the summary measures returned by the \code{summary} methods of #' the corresponding NMF results. #' @param sort.by the sorting criteria, i.e. a partial match of a column name, #' by which the result \code{data.frame} is sorted. The sorting direction #' (increasing or decreasing) is computed internally depending on the chosen #' criteria (e.g. decreasing for the cophenetic coefficient, increasing for the #' residuals). #' #' @rdname nmf-compare setMethod('summary', signature(object='NMFList'), function(object, sort.by=NULL, select=NULL, ...){ if( length(object) == 0L ) return() # define the sorting schema for each criteria (TRUE for decreasing, FALSE for increasing) sorting.schema <- list(method=FALSE, seed=FALSE, rng=FALSE, metric=FALSE , residuals=FALSE, cpu=FALSE, purity=TRUE, nrun=FALSE, cpu.all=FALSE , cophenetic=TRUE, dispersion=TRUE #NMFfitX only , entropy=FALSE, sparseness.basis=TRUE, sparseness.coef=TRUE, rank=FALSE, rss=FALSE , niter=FALSE, evar=TRUE , silhouette.coef = TRUE, silhouette.basis = TRUE , silhouette.consensus = TRUE) # for each result compute the summary measures measure.matrix <- sapply(object, summary, ...) # the results from 'summary' might not have the same length => generate NA where necessary if( is.list(measure.matrix) ){ name.all <- unique(unlist(sapply(measure.matrix, names))) measure.matrix <- sapply(seq_along(measure.matrix), function(i){ m <- measure.matrix[[i]][name.all] names(m) <- name.all m } ) } # transpose the results so that methods are in lines, measures are in columns measure.matrix <- t(measure.matrix) # set up the resulting data.frame methods <- sapply(object, function(x, ...){ x <- minfit(x) m <- algorithm(x) s <- seeding(x) svalue <- objective(x) svalue <- if( is.function(svalue) ) '' else svalue c(method=m, seed=s, rng=RNGdigest(x), metric=svalue) } ) methods <- t(methods) res <- as.data.frame(methods, stringsAsFactors=FALSE) # add the measures to the result res <- cbind(res, measure.matrix) res$rng <- as.numeric(factor(res$rng)) # sort according to the user's preference # ASSERT FOR DEV: all columns measure must have a defined sorting schema #if( !all( no.schema <- is.element(colnames(res), names(sorting.schema))) ) # warning("ASSERT: missing sorting schema for criteria(e): ", paste(paste("'", colnames(res)[!no.schema], "'", sep=''), collapse=', ')) if( !is.null(sort.by) ){ sorting.criteria <- intersect(colnames(res), names(sorting.schema)) sort.by.ind <- pmatch(sort.by, sorting.criteria) if( is.na(sort.by.ind) ) stop("NMF::summary[NMFList] : argument 'sort.by' must be NULL or partially match one of " , paste( paste("'", names(sorting.schema), "'", sep=''), collapse=', ') , call.=FALSE) sort.by <- sorting.criteria[sort.by.ind] res <- res[order(res[[sort.by]], decreasing=sorting.schema[[sort.by]]) , ] # add an attribute to the result to show the sorting criteria that was used attr(res, 'sort.by') <- sort.by } # limit the output to the required measures if( !is.null(select) || !missing(select) ){ select.full <- match.arg(select, colnames(res), several.ok=TRUE) if( length(select.full) < length(select) ) stop("NMF::summary[NMFList] - the elements of argument 'select' must partially match one of " , paste(paste("'", colnames(res),"'", sep=''), collapse=', ') , call.=FALSE) res <- subset(res, select=select.full) } # return result res } ) #' @details #' \code{plot} plot on a single graph the residuals tracks for each fit in \code{x}. #' See function \code{\link{nmf}} for details on how to enable the tracking of residuals. #' #' @param x an \code{NMFList} object that contains fits from separate NMF runs. #' @param y missing #' @inheritParams plot,NMFfit,missing-method #' #' @rdname nmf-compare setMethod('plot', signature(x='NMFList', y='missing'), function(x, y, skip=-1L, ...){ # retrieve normalized residuals tracks max.iter <- 0 tracks <- lapply( x, function(res){ res <- minfit(res) t <- residuals(res, track=TRUE) # skip some residuals(s) if requested if( skip == -1L && !is.null(names(t)) ) t <- t[names(t)!='0'] # remove initial residual else if( skip > 0 ) t <- t[-(1:skip)] #print(t) # update max iteration max.iter <<- max(max.iter, as.numeric(names(t))) # return normalized track t/t[1] } ) minT <- min(sapply(tracks, min)) maxT <- max(sapply(tracks, max)) #print(tracks) # create an empty plot # set default graphical parameters (those can be overriden by the user) params <- .set.list.defaults(list(...) , xlab='Iterations', ylab='Normalised objective values' , main='NMF Residuals') # setup the plot do.call('plot', c(list(0, xlim=c(0,max.iter+100), ylim=c(minT, maxT)), col='#00000000' , params) ) # add legend cols <- seq_along(tracks) legend('topright', legend=names(tracks), fill=cols , title='Algorithm') # plot each tracks lapply( seq_along(tracks), function(i){ t <- tracks[[i]] points(names(t), t, col=cols[i], type='p', cex=0.5) points(names(t), t, col=cols[i], type='l', lwd=1.4) }) # return invisible return(invisible()) } ) #' Deprecated method subsituted by \code{\link{consensusmap}}. setMethod('metaHeatmap', signature(object='NMFfitX'), function(object, ...){ # send deprecated warning .Deprecated('metaHeatmap', 'NMF', "Direct use of the S4-Method 'metaHeatmap' for 'NMFfitX' objects is deprecated, use 'consensusmap' instead.") # call the new function 'consmap' return( consensusmap(object, ...) ) } ) #' \code{consensusmap} plots heatmaps of consensus matrices. #' #' @details #' \code{consensusmap} redefines default values for the following arguments of #' \code{\link{aheatmap}}: #' \itemize{ #' \item the colour palette; #' \item the column ordering which is set equal to the row ordering, since #' a consensus matrix is symmetric; #' \item the distance and linkage methods used to order the rows (and columns). #' The default is to use 1 minus the consensus matrix itself as distance, and #' average linkage. #' \item the addition of two special named annotation tracks, \code{'basis:'} and #' \code{'consensus:'}, that show, for each column (i.e. each sample), #' the dominant basis component in the best fit and the hierarchical clustering #' of the consensus matrix respectively (using 1-consensus as distance and average #' linkage). #' #' These tracks are specified in argument \code{tracks}, which behaves as in #' \code{\link{basismap}}. #' #' \item a suitable title and extra information like the type of NMF model or the #' fitting algorithm, when \code{object} is a fitted NMF model. #' } #' #' @rdname heatmaps #' #' @examples #' #' \dontrun{ #' res <- nmf(x, 3, nrun=3) #' consensusmap(res) #' } #' #' @inline #' @export setGeneric('consensusmap', function(object, ...) standardGeneric('consensusmap') ) #' Plots a heatmap of the consensus matrix obtained when fitting an NMF model with multiple runs. setMethod('consensusmap', 'NMFfitX', function(object, annRow=NA, annCol=NA , tracks=c('basis:', 'consensus:', 'silhouette:') , main = 'Consensus matrix', info = FALSE , ...){ # add side information if requested info <- if( isTRUE(info) ){ paste("NMF model: '", modelname(object) , "'\nAlgorithm: '", algorithm(object) , "'\nbasis: ", nbasis(object) ,"\nnrun: ", nrun(object), sep='') }else if( isFALSE(info) ) NULL else info x <- consensus(object) # process annotation tracks ptracks <- process_tracks(x, tracks, annRow, annCol) annRow <- ptracks$row annCol <- ptracks$col # set special annotation handler ahandlers <- list( basis = function() predict(object) , consensus = function() predict(object, what='consensus') , silhouette = function(){ si <- silhouette(object, what='consensus', order = NA) if( is_NA(si) ) NA else si[, 'sil_width'] } ) specialAnnotation(1L, ahandlers) specialAnnotation(2L, ahandlers) # consensusmap(x, ..., annRow=annRow, annCol=annCol, main = main, info = info) } ) #' Plots a heatmap of the connectivity matrix of an NMF model. setMethod('consensusmap', 'NMF', function(object, ...){ consensusmap(connectivity(object), ...) } ) #' Main method that redefines default values for arguments of \code{\link{aheatmap}}. setMethod('consensusmap', 'matrix', function(object, color='-RdYlBu' , distfun = function(x) as.dist(1-x), hclustfun = 'average' , Rowv = TRUE, Colv = "Rowv" , main = if( is.null(nr) || nr > 1 ) 'Consensus matrix' else 'Connectiviy matrix' , info = FALSE , ...){ nr <- nrun(object) nb <- nbasis(object) info <- if( isTRUE(info) ){ info <- NULL if( !is.null(nr) ) info <- c(info, paste("nrun:", nr)) if( !is.null(nb) ) info <- c(info, paste("nbasis:", nb)) info <- c(info, paste("cophcor:", round(cophcor(object), 3))) }else if( isFALSE(info) ) NULL else info aheatmap(object, color = color, ... , distfun = distfun, hclustfun = hclustfun , Rowv = Rowv, Colv = Colv , main = main , info = info) } ) setOldClass('NMF.rank') #' Draw a single plot with a heatmap of the consensus matrix obtained for each value of the rank, #' in the range tested with \code{\link{nmfEstimateRank}}. #' #' @rdname nmf-compare setMethod('consensusmap', 'NMF.rank', function(object, ...){ # plot the list of consensus matrix (set names to be used as default main titles) consensusmap(setNames(object$fit, paste("rank = ", lapply(object$fit, nbasis))), ...) } ) #' Draw a single plot with a heatmap of the consensus matrix of each element in the list \code{object}. #' #' @param layout specification of the layout. #' It may be a single numeric or a numeric couple, to indicate a square or rectangular layout #' respectively, that is filled row by row. #' It may also be a matrix that is directly passed to the function \code{\link[graphics]{layout}} #' from the package \code{graphics}. #' #' @rdname nmf-compare setMethod('consensusmap', 'list', function(object, layout , Rowv = FALSE, main = names(object) , ...){ opar <- par(no.readonly=TRUE) on.exit(par(opar)) # define default layout if (missing(layout) ){ n <- length(object) nr <- nc <- floor(sqrt(n)) if( nr^2 != n ){ nc <- nr + 1 if( nr == 1 && nr*nc < n ) nr <- nr + 1 } layout <- c(nr, nc) } if( !is.matrix(layout) ){ if( !is.numeric(layout) ) stop("invalid layout specification: must be a matrix or a numeric") if( length(layout) == 1 ) layout <- c(layout, layout) layout <- matrix(1:(layout[1]*layout[2]), layout[1], byrow=TRUE) } graphics::layout(layout) res <- sapply(seq_along(object), function(i, ...){ x <- object[[i]] # set main title main <- if( !is.null(main) && length(main) > 1 ){ if( length(main) != length(object) ) stop("consensusmap - Invalid length for argument `main`: should be either a single character string, or a list or vector of same length as ", deparse(substitute(object))) main[[i]] } # call method for the fit consensusmap(x, ..., Rowv=Rowv, main=main) }, ...) invisible(res) } ) #' Plots a heatmap of the basis matrix of the best fit in \code{object}. setMethod('basismap', signature(object='NMFfitX'), function(object, ...){ # call the method on the best fit basismap(minfit(object), ...) } ) #' Plots a heatmap of the coefficient matrix of the best fit in \code{object}. #' #' This method adds: #' \itemize{ #' \item an extra special column annotation track for multi-run NMF fits, #' \code{'consensus:'}, that shows the consensus cluster associated to each sample. #' \item a column sorting schema \code{'consensus'} that can be passed #' to argument \code{Colv} and orders the columns using the hierarchical clustering of the #' consensus matrix with average linkage, as returned by \code{\link{consensushc}(object)}. #' This is also the ordering that is used by default for the heatmap of the consensus matrix #' as ploted by \code{\link{consensusmap}}. #' } setMethod('coefmap', signature(object='NMFfitX'), function(object , Colv=TRUE , annRow=NA, annCol=NA , tracks=c('basis', 'consensus:') , ...){ x <- minfit(object) # process annotation tracks ptracks <- process_tracks(x, tracks, annRow, annCol) annRow <- ptracks$row annCol <- ptracks$col # set special annotation handler specialAnnotation(2L, 'consensus', function() predict(object, what='consensus')) # row track handler is added in coefmap,NMF # ## process ordering if( isString(Colv) ){ if( Colv %in% c('consensus', 'cmap') ) Colv <- consensushc(object, 'consensus') } ## # call the method on the best fit coefmap(x, ..., Colv=Colv, annRow=annRow, annCol=annCol, tracks=NA) } ) #' Cophenetic Correlation Coefficient #' #' The function \code{cophcor} computes the cophenetic correlation coefficient #' from consensus matrix \code{object}, e.g. as obtained from multiple NMF runs. #' #' The cophenetic correlation coeffificient is based on the consensus matrix #' (i.e. the average of connectivity matrices) and was proposed by #' \cite{Brunet2004} to measure the stability of the clusters obtained from NMF. #' #' It is defined as the Pearson correlation between the samples' distances #' induced by the consensus matrix (seen as a similarity matrix) and their #' cophenetic distances from a hierachical clustering based on these very #' distances (by default an average linkage is used). #' See \cite{Brunet2004}. #' #' @param object an object from which is extracted a consensus matrix. #' @param ... extra arguments to allow extension and passed to subsequent calls. #' #' @inline #' @seealso \code{\link{cophenetic}} #' @export setGeneric('cophcor', function(object, ...) standardGeneric('cophcor') ) #' Workhorse method for matrices. #' #' @param linkage linkage method used in the hierarchical clustering. #' It is passed to \code{\link{hclust}}. #' setMethod('cophcor', signature(object='matrix'), function(object, linkage='average'){ # check for empty matrix if( nrow(object)==0 || ncol(object)==0 ) { warning("NMF::cophcor - NA produced [input matrix is of dimension ", nrow(object), "x", ncol(object), "]" , call.=FALSE) return(NA) } # safe-guard for diagonal matrix: to prevent error in 'cor' if( all(object[upper.tri(object)]==0) && all(diag(object)==object[1,1]) ) return(1) # convert consensus matrix into dissimilarities d.consensus <- as.dist(1 - object) # compute cophenetic distance based on these dissimilarities hc <- hclust(d.consensus, method=linkage) d.coph <- cophenetic(hc) # return correlation between the two distances res <- cor(d.consensus, d.coph, method='pearson') return(res) } ) #' Computes the cophenetic correlation coefficient on the consensus matrix #' of \code{object}. #' All arguments in \code{...} are passed to the method \code{cophcor,matrix}. setMethod('cophcor', signature(object='NMFfitX'), function(object, ...){ # compute the consensus matrix C <- consensus(object) return( cophcor(C, ...)) } ) # TODO: uncomment this and make it compute the mean or best rss #setMethod('rss', 'NMFfitXn', # function(object, target, ...){ # rss(fit(object, ...), target) # } #) NMF/R/NMFOffset-class.R0000644000176000001440000001145712234465004014150 0ustar ripleyusers#' @include NMFstd-class.R NULL #' NMF Model - Nonnegative Matrix Factorization with Offset #' #' This class implements the \emph{Nonnegative Matrix Factorization with #' Offset} model, required by the NMF with Offset algorithm. #' #' The NMF with Offset algorithm is defined by \cite{Badea2008} as a modification #' of the euclidean based NMF algorithm from \code{Lee2001} (see section Details and #' references below). #' It aims at obtaining 'cleaner' factor matrices, by the introduction of an #' offset matrix, explicitly modelling a feature specific baseline #' -- constant across samples. #' #' @section Creating objects from the Class: #' #' Object of class \code{NMFOffset} can be created using the standard way with #' operator \code{\link{new}} #' #' However, as for all NMF model classes -- that extend class #' \code{\linkS4class{NMF}}, objects of class \code{NMFOffset} should be #' created using factory method \code{\link{nmfModel}} : #' #' \code{new('NMFOffset')} #' #' \code{nmfModel(model='NMFOffset')} #' #' \code{nmfModel(model='NMFOffset', W=w, offset=rep(1, nrow(w)))} #' #' See \code{\link{nmfModel}} for more details on how to use the factory #' method. #' #' @export #' @family NMF-model #' @examples #' #' # create a completely empty NMF object #' new('NMFOffset') #' #' # create a NMF object based on random (compatible) matrices #' n <- 50; r <- 3; p <- 20 #' w <- rmatrix(n, r) #' h <- rmatrix(r, p) #' nmfModel(model='NMFOffset', W=w, H=h, offset=rep(0.5, nrow(w))) #' #' # apply Nonsmooth NMF algorithm to a random target matrix #' V <- rmatrix(n, p) #' \dontrun{nmf(V, r, 'offset')} #' #' # random NMF model with offset #' rnmf(3, 10, 5, model='NMFOffset') #' setClass('NMFOffset' , representation( offset = 'numeric' # offset vector ) , contains = 'NMFstd' , prototype=prototype( offset = numeric() ) ) #' Show method for objects of class \code{NMFOffset} #' @export setMethod('show', 'NMFOffset', function(object) { callNextMethod() cat("offset: ") if( length(object@offset) > 0 ){ cat('[', head(object@offset, 5) , if( length(object@offset) > 5 ) "..." else NULL , ']') } else cat('none') cat("\n") } ) #' @section Initialize method: #' The initialize method for \code{NMFOffset} objects tries to correct the initial #' value passed for slot \code{offset}, so that it is consistent with the dimensions #' of the \code{NMF} model: #' it will pad the offset vector with NA values to get the length equal to the #' number of rows in the basis matrix. #' #' @param offset optional numeric vector used to initialise slot \sQuote{offset}. #' #' @rdname NMFOffset-class setMethod("initialize", 'NMFOffset', function(.Object, ..., offset){ .Object <- callNextMethod() # correct the offset slot if possible if( missing(offset) ) offset <- numeric() if( !is.numeric(offset) ) stop("Unvalid value for parameter 'offset': a numeric vector is expected") # force length to be consistent with the factorization's dimension n <- nrow(.Object) if( n > 0 ) .Object@offset <- c( offset, rep(NA, max(0, n - length(offset))) )[1:n] # return the initialized valid object .Object } ) #' @export setGeneric('offset', package='stats') #' Offsets in NMF Models with Offset #' #' The function \code{offset} returns the offset vector from an NMF model #' that has an offset, e.g. an \code{NMFOffset} model. #' @param object an instance of class \code{NMFOffset}. #' setMethod('offset', signature(object='NMFOffset'), function(object){ object@offset } ) #' Computes the target matrix estimate for an NMFOffset object. #' #' The estimate is computed as: #' \deqn{ W H + offset } #' #' @param offset offset vector #' @inline setMethod('fitted', signature(object='NMFOffset'), function(object, W, H, offset=object@offset){ if( missing(W) ) W <- object@W if( missing(H) ) H <- object@H object@W %*% object@H + offset } ) #' Generates a random NMF model with offset, from class \code{NMFOffset}. #' #' The offset values are drawn from a uniform distribution between 0 and #' the maximum entry of the basis and coefficient matrices, which are drawn #' by the next suitable \code{\link{rnmf}} method, which is the workhorse #' method \code{rnmf,NMF,numeric}. #' #' @examples #' #' # random NMF model with offset #' x <- rnmf(2, 3, model='NMFOffset') #' x #' offset(x) #' # from a matrix #' x <- rnmf(2, rmatrix(5,3, max=10), model='NMFOffset') #' offset(x) #' setMethod('rnmf', signature(x='NMFOffset', target='numeric'), function(x, target, ...){ # call the parent's 'rnmf' method to build a standard random NMF factorization res <- callNextMethod() #Vc# Initialize a random offset of length the number of genes res@offset <- runif(nrow(res), min=0, max=max(basis(res), coef(res))); # return the initialized NMFOffset object res }) NMF/R/nmfModel.R0000644000176000001440000006776412234465004013033 0ustar ripleyusers# Factory/Constructor Methods for NMF models # # Author: Renaud Gaujoux # Creation: 03 Jul 2012 ############################################################################### #' @include NMFstd-class.R #' @include NMFns-class.R #' @include NMFOffset-class.R NULL #' Factory Methods NMF Models #' #' \code{nmfModel} is a S4 generic function which provides a convenient way to #' build NMF models. #' It implements a unified interface for creating \code{NMF} objects from any #' NMF models, which is designed to resolve potential dimensions inconsistencies. #' #' All \code{nmfModel} methods return an object that inherits from class \code{NMF}, #' that is suitable for seeding NMF algorithms via arguments \code{rank} or #' \code{seed} of the \code{\link{nmf}} method, in which case the factorisation #' rank is implicitly set by the number of basis components in the seeding #' model (see \code{\link{nmf}}). #' #' For convenience, shortcut methods and internal conversions for working on #' \code{data.frame} objects directly are implemented. #' However, note that conversion of a \code{data.frame} into a \code{matrix} #' object may take some non-negligible time, for large datasets. #' If using this method or other NMF-related methods several times, consider #' converting your data \code{data.frame} object into a matrix once for good, #' when first loaded. #' #' @param rank specification of the target factorization rank #' (i.e. the number of components). #' @param target an object that specifies the dimension of the estimated target matrix. #' @param ... extra arguments to allow extension, that are passed down to the #' workhorse method \code{nmfModel,numeric.numeric}, where they are used to #' initialise slots specific to the instantiating NMF model class. #' #' @return an object that inherits from class \code{\linkS4class{NMF}}. #' @family NMF-interface #' @export #' @inline setGeneric('nmfModel', function(rank, target=0L, ...) standardGeneric('nmfModel')) #' Main factory method for NMF models #' #' This method is the workhorse method that is eventually called by all other methods. #' See section \emph{Main factory method} for more details. #' #' @param ncol a numeric value that specifies the number #' of columns of the target matrix, fitted the NMF model. #' It is used only if not missing and when argument \code{target} is a single #' numeric value. #' @param model the class of the object to be created. #' It must be a valid class name that inherits from class \code{NMF}. #' Default is the standard NMF model \code{\linkS4class{NMFstd}}. #' @param W value for the basis matrix. #' \code{data.frame} objects are converted into matrices with \code{\link{as.matrix}}. #' @param H value for the mixture coefficient matrix #' \code{data.frame} objects are converted into matrices with \code{\link{as.matrix}}. #' @param force.dim logical that indicates whether the method should try #' lowering the rank or shrinking dimensions of the input matrices to #' make them compatible #' @param order.basis logical that indicates whether the basis components should #' reorder the rows of the mixture coefficient matrix to match the order of the #' basis components, based on their respective names. It is only used if the #' basis and coefficient matrices have common unique column and row names #' respectively. #' #' @section Main factory method: #' The main factory engine of NMF models is implemented by the method with #' signature \code{numeric, numeric}. #' Other factory methods provide convenient ways of creating NMF models from e.g. a #' given target matrix or known basis/coef matrices (see section \emph{Other Factory Methods}). #' #' This method creates an object of class \code{model}, using the extra #' arguments in \code{...} to initialise slots that are specific to the given model. #' #' All NMF models implement get/set methods to access the matrix factors #' (see \code{\link{basis}}), which are called to initialise them from arguments #' \code{W} and \code{H}. #' These argument names derive from the definition of all built-in models that #' inherit derive from class \code{\linkS4class{NMFstd}}, which has two slots, #' \var{W} and \var{H}, to hold the two factors -- following the notations used #' in \cite{Lee1999}. #' #' If argument \code{target} is missing, the method creates a standard NMF #' model of dimension 0x\code{rank}x0. #' That is that the basis and mixture coefficient matrices, \var{W} and \var{H}, #' have dimension 0x\code{rank} and \code{rank}x0 respectively. #' #' If target dimensions are also provided in argument \code{target} as a #' 2-length vector, then the method creates an \code{NMF} object compatible to #' fit a target matrix of dimension \code{target[1]}x\code{target[2]}. #' That is that the basis and mixture coefficient matrices, \var{W} and \var{H}, #' have dimension \code{target[1]}x\code{rank} and \code{rank}x\code{target[2]} #' respectively. #' The target dimensions can also be specified using both arguments \code{target} #' and \code{ncol} to define the number of rows and the number of columns of the #' target matrix respectively. #' If no other argument is provided, these matrices are filled with NAs. #' #' If arguments \code{W} and/or \code{H} are provided, the method creates a NMF #' model where the basis and mixture coefficient matrices, \var{W} and \var{H}, #' are initialised using the values of \code{W} and/or \code{H}. #' #' The dimensions given by \code{target}, \code{W} and \code{H}, must be compatible. #' However if \code{force.dim=TRUE}, the method will reduce the dimensions to the achieve #' dimension compatibility whenever possible. #' #' When \code{W} and \code{H} are both provided, the \code{NMF} object created is #' suitable to seed a NMF algorithm in a call to the \code{\link{nmf}} method. #' Note that in this case the factorisation rank is implicitly set by the number #' of basis components in the seed. #' #' @examples #' #' # data #' n <- 20; r <- 3; p <- 10 #' V <- rmatrix(n, p) # some target matrix #' #' # create a r-ranked NMF model with a given target dimensions n x p as a 2-length vector #' nmfModel(r, c(n,p)) # directly #' nmfModel(r, dim(V)) # or from an existing matrix <=> nmfModel(r, V) #' # or alternatively passing each dimension separately #' nmfModel(r, n, p) #' #' # trying to create a NMF object based on incompatible matrices generates an error #' w <- rmatrix(n, r) #' h <- rmatrix(r+1, p) #' try( new('NMFstd', W=w, H=h) ) #' try( nmfModel(w, h) ) #' try( nmfModel(r+1, W=w, H=h) ) #' # The factory method can be force the model to match some target dimensions #' # but warnings are thrown #' nmfModel(r, W=w, H=h) #' nmfModel(r, n-1, W=w, H=h) #' setMethod('nmfModel', signature(rank='numeric', target='numeric'), function(rank, target, ncol=NULL, model='NMFstd', W, H, ..., force.dim=TRUE, order.basis=TRUE){ if( is.null(model) ) model <- 'NMFstd' # check validity of the provided class if( !isClass(model) ) stop("nmfModel - Invalid model name: class '", model,"' is not defined.") if( !extends(model, 'NMF') ) stop("nmfModel - Invalid model name: class '", model,"' does not extend class 'NMF'.") # check the validity of the target if( length(target) == 0 ) stop('nmfModel - Invalid dimensions: `target` must be at least of length 1') if( length(target) > 2 ) stop('nmfModel - Invalid dimensions: `target` must be at most of length 2') if( !missing(ncol) && !is.null(ncol) && (!is.vector(ncol) || length(ncol) > 1 || !is.numeric(ncol) || ncol<0 ) ) stop('nmfModel - Invalid dimensions: `ncol` must be a single nonnegative integer') # compute the target dimension target <- as.integer(target) n <- target[1] m <- if( length(target) == 2 ) target[2] else if( !missing(ncol) && !is.null(ncol) ) ncol else if( !missing(H) ) ncol(H) else n if( n < 0 ) stop("nmfModel - Invalid target number of rows: nonnegative value expected") if( m < 0 ) stop("nmfModel - Invalid target number of columns: nonnegative value expected") # force rank to be an integer r <- as.integer(rank) # check the validity of the rank if( length(r) != 1 ) stop("Invalid argument 'rank': single numeric expected") if( r < 0 ) stop("nmfModel - Invalid argument 'rank': nonnegative value expected") # do not allow dimension incompatibility if required if( !force.dim && !missing(W) && !missing(H) && ncol(W) != nrow(H) ){ stop('nmfModel - Invalid number of columns in the basis matrix [', ncol(W), ']: ' , 'it should match the number of rows in the mixture coefficient matrix [', nrow(H), ']') } # build dummy compatible W and H if necessary W.was.missing <- FALSE if( missing(W) ){ W <- matrix(as.numeric(NA), n, r) W.was.missing <- TRUE } else{ if( is.vector(W) ) # convert numerical vectors into a matrix W <- matrix(W, n, r) else if( is.data.frame(W) ) # convert data.frame into matrix W <- as.matrix(W) if( r == 0 ) r <- ncol(W) else if( r < ncol(W) ){ if( !force.dim ){ stop('nmfModel - Invalid number of columns in the basis matrix [', ncol(W), ']: ', 'it should match the factorization rank [', r, ']') } warning("Objective rank is [",r,"] lower than the number of columns in W [",ncol(W),"]: " , "only the first ", r," columns of W will be used") W <- W[,1:r, drop=FALSE] } else if( r > ncol(W) ){ stop("nmfModel - Objective rank [",r,"] is greater than the number of columns in W [",ncol(W),"]") } # resolve consistency with target if( n == 0 ) n <- nrow(W) else if( n < nrow(W) ){ if( !force.dim ){ stop('nmfModel - Invalid number of rows in the basis matrix [', nrow(W), ']: ' , 'it should match the target number of rows [', n, ']') } warning("nmfModel - Number of rows in target is lower than the number of rows in W [",nrow(W),"]: ", "only the first ", n," rows of W will be used") W <- W[1:n, , drop=FALSE] } else if( n > nrow(W) ){ stop("nmfModel - Number of rows in target [",n,"] is greater than the number of rows in W [",nrow(W),"]") } } if( missing(H) ) H <- matrix(as.numeric(NA), ncol(W), m) else{ # convert numerical vectors into a matrix if( is.vector(H) ) H <- matrix(H, r, m) else if( is.data.frame(H) ) # convert data.frame into matrix H <- as.matrix(H) if( r == 0 ) r <- nrow(H) else if( r < nrow(H) ){ if( !force.dim ){ stop('nmfModel - Invalid number of rows in the mixture coefficient matrix [', nrow(H), ']: ' , 'it should match the factorization rank [', r, ']') } warning("nmfModel - Objective rank [",r,"] is lower than the number of rows in H [",nrow(H),"]: " , "only the first ", r," rows of H will be used") H <- H[1:r,, drop=FALSE] } else if( r > nrow(H) ) stop("nmfModel - Objective rank [",r,"] is greater than the number of rows in H [",nrow(H),"]") # force dummy W to be at least compatible with H if( W.was.missing ) W <- matrix(as.numeric(NA), n, r) # resolve consistency with target if( m == 0 ) m <- ncol(H) else if( m < ncol(H) ){ if( !force.dim ){ stop('nmfModel - Invalid number of columns in the mixture coefficient matrix [', ncol(H), ']:' , ' it should match the target number of columns [', m, ']') } warning("nmfModel - Number of columns in target is lower than the number of columns in H [",ncol(H),"]:" , " only the first ", m," columns of H will be used") H <- H[, 1:m, drop=FALSE] } else if( m > ncol(H) ){ stop("nmfModel - Number of columns in target [",m,"]" ," is greater than the number of columns in H [",ncol(H),"]") } } # check validity of matrices W and H (only if one of the target dimension is not null) if( n + m > 0 ){ if( nrow(W) != n ) stop('nmfModel - Invalid number of rows for W: should match number of rows in target [', n, ']') if( ncol(W) != r ) stop('nmfModel - Invalid number of columns for W: should match factorization rank [', r, ']') if( nrow(H) != r ) stop('nmfModel - Invalid number of rows for H: should match factorization rank [', r, ']') if( ncol(H) != m ) stop('nmfModel - Invalid number of columns for H: should match number of columns in target [', m, ']') } # build and return a dummy NMF object nmf.debug('nmfModel', "Instantiate NMF model:", model) res <- new(model, ...) nmf.debug('nmfModel', "Set factors in model:", model) # set the dimnames if possible cW <- !is.null(colnames(W)) rH <- !is.null(rownames(H)) if( cW && !rH )# use colnames of W as basisnames rownames(H) <- colnames(W) else if( !cW && rH )# use rownames of H as basisnames colnames(W) <- rownames(H) else if( cW && rH ){# try to match names or use colnames of W (with a warning) # reorder as in the basis matrix if it makes sense, i.e. if the names are the same if( order.basis && !anyDuplicated(rownames(H)) && length(setdiff(rownames(H), colnames(W)))==0 ){ H <- H[match(rownames(H), colnames(W)),] } else{ rownames(H) <- colnames(W) warning("nmfModel - The rownames of the mixture matrix were set to match the colnames of the basis matrix") } } # set the basis and coef matrices .basis(res) <- W; .coef(res) <- H # check validity validObject(res) # return the model res } ) #' Creates an empty NMF model of a given rank. #' #' This call is equivalent to \code{nmfModel(rank, 0L, ...)}, which #' creates \emph{empty} \code{NMF} object with a basis and mixture coefficient matrix #' of dimension 0 x \code{rank} and \code{rank} x 0 respectively. #' #' @seealso \code{\link{is.empty.nmf}} #' @examples #' ## Empty model of given rank #' nmfModel(3) #' setMethod('nmfModel', signature(rank='numeric', target='missing'), function(rank, target, ...){ nmfModel(rank, 0L, ...) } ) #' Creates an empty NMF model of null rank and a given dimension. #' #' This call is equivalent to \code{nmfModel(0, target, ...)}. #' #' @examples #' nmfModel(target=10) #square #' nmfModel(target=c(10, 5)) #' setMethod('nmfModel', signature(rank='missing', target='ANY'), function(rank, target, ...){ nmfModel(0L, target, ...) } ) #' Creates an empty NMF model of null rank and given dimension. #' #' This call is equivalent to \code{nmfModel(0, target, ...)}, and is meant for #' internal usage only. setMethod('nmfModel', signature(rank='NULL', target='ANY'), function(rank, target, ...){ nmfModel(0L, target, ...) } ) #' Creates an empty NMF model or from existing factors #' #' This method is equivalent to \code{nmfModel(0, 0, ..., force.dim=FALSE)}. #' This means that the dimensions of the NMF model will be taken from the optional #' basis and mixture coefficient arguments \code{W} and \code{H}. #' An error is thrown if their dimensions are not compatible. #' #' Hence, this method may be used to generate an NMF model from existing factor #' matrices, by providing the named arguments \code{W} and/or \code{H}: #' #' \code{nmfModel(W=w)} or \code{nmfModel(H=h)} or \code{nmfModel(W=w, H=h)} #' #' Note that this may be achieved using the more convenient interface is #' provided by the method \code{nmfModel,matrix,matrix} (see its dedicated description). #' #' See the description of the appropriate method below. #' #' @examples #' #' # Build an empty NMF model #' nmfModel() #' #' # create a NMF object based on one random matrix: the missing matrix is deduced #' # Note this only works when using factory method NMF #' n <- 50; r <- 3; #' w <- rmatrix(n, r) #' nmfModel(W=w) #' #' # create a NMF object based on random (compatible) matrices #' p <- 20 #' h <- rmatrix(r, p) #' nmfModel(H=h) #' #' # specifies two compatible matrices #' nmfModel(W=w, H=h) #' # error if not compatible #' try( nmfModel(W=w, H=h[-1,]) ) #' setMethod('nmfModel', signature(rank='missing', target='missing'), function(rank, target, ...){ # build an a priori empty model (extra args may provide the true dimension) # NB: do not allow dimension incompatibilities nmfModel(0L, 0L, ..., force.dim=FALSE) } ) #' Creates an NMF model compatible with a target matrix. #' #' This call is equivalent to \code{nmfModel(rank, dim(target), ...)}. #' That is that the returned NMF object fits a target matrix of the same #' dimension as \code{target}. #' #' Only the dimensions of \code{target} are used to construct the \code{NMF} object. #' The matrix slots are filled with \code{NA} values if these are not specified #' in arguments \code{W} and/or \code{H}. #' However, dimension names are set on the return NMF model if present in #' \code{target} and argument \code{use.names=TRUE}. #' #' @param use.names a logical that indicates whether the dimension names of the #' target matrix should be set on the returned NMF model. #' #' @inline #' @examples #' #' # create a r-ranked NMF model compatible with a given target matrix #' obj <- nmfModel(r, V) #' all(is.na(basis(obj))) #' setMethod('nmfModel', signature(rank='numeric', target='matrix'), function(rank, target, ..., use.names=TRUE){ # build an object compatible with the target's dimensions res <- nmfModel(rank, dim(target), ...) # try to set dimnames if it makes sense: # set on target and not somehow already set on the result if( use.names && !is.null(dimnames(target)) ){ dn <- dimnames(res) if( is.null(dn) ) dn <- list(NULL, NULL, NULL) if( is.null(rownames(res)) && !is.null(rownames(target)) ) dimnames(res) <- c(dimnames(target)[1], dn[2:3]) if( is.null(colnames(res)) && !is.null(colnames(target)) ) dimnames(res) <- c(dimnames(res)[1], dimnames(target)[2], dimnames(res)[3]) } res } ) #' Creates an NMF model based on two existing factors. #' #' This method is equivalent to \code{nmfModel(0, 0, W=rank, H=target..., force.dim=FALSE)}. #' This allows for a natural shortcut for wrapping existing \strong{compatible} #' matrices into NMF models: #' \samp{nmfModel(w, h)} #' #' Note that an error is thrown if their dimensions are not compatible. #' #' @examples #' ## From two existing factors #' #' # allows a convenient call without argument names #' w <- rmatrix(n, 3); h <- rmatrix(3, p) #' nmfModel(w, h) #' #' # Specify the type of NMF model (e.g. 'NMFns' for non-smooth NMF) #' mod <- nmfModel(w, h, model='NMFns') #' mod #' #' # One can use such an NMF model as a seed when fitting a target matrix with nmf() #' V <- rmatrix(mod) #' res <- nmf(V, mod) #' nmf.equal(res, nmf(V, mod)) #' #' # NB: when called only with such a seed, the rank and the NMF algorithm #' # are selected based on the input NMF model. #' # e.g. here rank was 3 and the algorithm "nsNMF" is used, because it is the default #' # algorithm to fit "NMFns" models (See ?nmf). #' setMethod('nmfModel', signature(rank='matrix', target='matrix'), function(rank, target, ...){ # use rank and target as W and H respectively # NB: do not allow dimension incompatibilities nmfModel(0L, 0L, W=rank, H=target, ..., force.dim=FALSE) } ) #' Same as \code{nmfModel('matrix', 'matrix')} but for \code{data.frame} objects, #' which are generally produced by \code{\link{read.delim}}-like functions. #' #' The input \code{data.frame} objects are converted into matrices with #' \code{\link{as.matrix}}. setMethod('nmfModel', signature(rank='data.frame', target='data.frame'), function(rank, target, ...){ nmfModel(as.matrix(rank), as.matrix(target), ...) } ) #' Creates an NMF model with arguments \code{rank} and \code{target} swapped. #' #' This call is equivalent to \code{nmfModel(rank=target, target=rank, ...)}. #' This allows to call the \code{nmfModel} function with arguments \code{rank} #' and \code{target} swapped. #' It exists for convenience: #' \itemize{ #' \item allows typing \code{nmfModel(V)} instead of \code{nmfModel(target=V)} to create #' a model compatible with a given matrix \code{V} (i.e. of dimension \code{nrow(V), 0, ncol(V)}) #' \item one can pass the arguments in any order (the one that comes to the user's mind first) #' and it still works as expected. #' } #' #' @examples #' ## swapped arguments `rank` and `target` #' V <- rmatrix(20, 10) #' nmfModel(V) # equivalent to nmfModel(target=V) #' nmfModel(V, 3) # equivalent to nmfModel(3, V) #' setMethod('nmfModel', signature(rank='matrix', target='ANY'), function(rank, target, ...){ if( missing(target) ) target <- NULL # call nmfModel with swapping the arguments nmfModel(target, rank, ...) } ) #' Simple Parsing of Formula #' #' Formula parser for formula-based NMF models. #' #' @param x formula to parse #' @return a list with the following elements: #' \item{response}{ logical that indicates if the formula has a response term.} #' \item{y}{ name of the response variable.} #' \item{x}{ list of regressor variable names.} #' \item{n}{ number of regressor variables.} #' #' @keywords internal parse_formula <- function(x){ res <- list() # parse formula f <- as.character(x) hasResponse <- length(f) == 3L # response res$response <- hasResponse res$y <- if( hasResponse ) f[2L] # regressors reg <- if( hasResponse ) f[3L] else f[2L] res$x <- strsplit(reg, ' ')[[1]] res$n <- length(res$reg) # as a tring res$string <- paste(res$y, '~', reg, collapse='') res } #' Build a formula-based NMF model, that can incorporate fixed basis or #' coefficient terms. #' #' @param data Optional argument where to look for the variables used in the #' formula. #' @param no.attrib logical that indicate if attributes containing data related #' to the formula should be attached as attributes. #' If \code{FALSE} attributes \code{'target'} and \code{'formula'} contain the #' target matrix, and a list describing each formula part (response, regressors, #' etc.). #' #' @inline #' #' @examples #' #' # empty 3-rank model #' nmfModel(~ 3) #' #' # 3-rank model that fits a given data matrix #' x <- rmatrix(20,10) #' nmfModel(x ~ 3) #' #' # add fixed coefficient term defined by a factor #' gr <- gl(2, 5) #' nmfModel(x ~ 3 + gr) #' #' # add fixed coefficient term defined by a numeric covariate #' nmfModel(x ~ 3 + gr + b, data=list(b=runif(10))) #' #' # 3-rank model that fits a given ExpressionSet (with fixed coef terms) #' e <- ExpressionSet(x) #' pData(e) <- data.frame(a=runif(10)) #' nmfModel(e ~ 3 + gr + a) # `a` is looked up in the phenotypic data of x pData(x) #' setMethod('nmfModel', signature(rank='formula', target='ANY'), function(rank, target, ..., data=NULL, no.attrib=FALSE){ # missing target is NULL if( missing(target) ) target <- NULL # data is a model class name (passed from nmf) if( is.character(data) ){ model <- data data <- NULL }else model <- NULL # parse formula f <- parse_formula(rank) enclos <- environment(rank) rank <- 0L if( is.vector(target) && is.numeric(target) ){ rank <- target target <- NULL } # utility function to merge data and pData merge_pdata <- function(x, data){ pd <- pData(x) if( length(pd) ){ if( is.null(data) ) pd else{ cbind(data, pd) } }else data } # determine formula data if( is.null(data) ){ # target data.frame taken as data if a response variable if defined if( is.data.frame(target) && f$response ){ data <- target target <- NULL }else if( is.environment(target) ){ # use target as enclosure enclos <- target target <- NULL } } # determine target matrix: X <- 0L # if a response term is present, lookup target data in other arguments if( f$response ){ X <- eval(parse(text=f$y), enclos) if( is.eset(target) && !identical(X, target) ){ warning("Conflicting response term and target: the ExpressionSet in `target` will only be used for covariates.") data <- merge_pdata(target, data) } } else if( is.null(target) ){ # no response, no target: try ExpressionSet in data if( is.eset(data) ){ X <- exprs(data) } }else{ X <- target } # merge data and pData from ExpressionSet target if( is.eset(X) ){ data <- merge_pdata(X, data) X <- exprs(X) } r <- rank cterms <- bterms <- list() # dimensions are also inferred from the formula n <- if( identical(X, 0L) ) 0L else nrow(X) p <- if( identical(X, 0L) ) 0L else ncol(X) for( v in f$x ){ if( grepl("^[0-9]+$", v) ){ if( rank == 0L ){ # rank not specified in target r <- as.numeric(v) }else{ warning("NMF::nmfModel - Discarding rank specified in the formula [", v,"]:" , " using value specified in target rank instead [", rank, "].") } }else if( grepl("^[+-]$", v) ) next else { val <- eval(parse(text=v), data, enclos) .add_term <- function(v, val, type = NULL){ if( p==0L || length(val) == p || identical(type, 'coef') ){ cterms[[v]] <<- val if( p==0L ) p <<- length(val) }else if( n==0L || length(val) == n || identical(type, 'basis') ){ bterms[[v]] <<- val if( n==0L ) n <<- length(val) }else stop("Invalid", type," term '", v, "' length [", length(val), "]:" , " length must either be the number of target columns [", p, "]" , " or rows [", n, "]") } if( is.null(dim(val)) ) .add_term(v, val) else if( n == 0L || nrow(val) == n ){ lapply(1:ncol(val), function(i){ if( !is.null(cname <- colnames(val)[i]) && nzchar(cname) ) vname <- cname else vname <- paste0(v, i) .add_term(vname, val[, i], type = 'basis') }) }else{ # special handling of data.frames: # -> coef terms are passed as column variables if( is.data.frame(val) && (p == 0L || nrow(val) == p)){ val <- t(val) } if( p == 0L || ncol(val) == p ){ lapply(1:nrow(val), function(i){ if( !is.null(cname <- rownames(val)[i]) && nzchar(cname) ) vname <- cname else vname <- paste0(v, i) .add_term(vname, val[i, ], type = 'coef') }) }else{ stop("Incompatible matrix-like term '", v, "' dimensions [", str_dim(val), "]:" , " number of rows or columns must match the ones of the target matrix [", str_dim(X, dims = c(n, p)) ,"]") } } } } # try to fixup X if possible if( identical(X, 0L) ) X <- c(n, p) # call nmfModel with cterms if( hasArg(model) || is.null(model) ) object <- nmfModel(r, X, ...) else object <- nmfModel(r, X, ..., model=model) # set fixed basis terms if( length(bterms) ){ bterms(object) <- as.data.frame(bterms) } # set fixed coef terms if( length(cterms) ){ cterms(object) <- as.data.frame(cterms) } # valid object validObject(object) # attach formula data if( !no.attrib ){ attr(object, 'target') <- X attr(object, 'formula') <- f } # return object object } ) #' Listing NMF Models #' #' \code{nmfModels} lists all available NMF models currently defined that can be #' used to create NMF objects, i.e. -- more or less -- all S4 classes that #' inherit from class \code{\linkS4class{NMF}}. #' #' @param builtin.only logical that indicates whether only built-in NMF models, #' i.e. defined within the NMF package, should be listed. #' #' @return a list #' #' @export #' @family NMF-interface #' @rdname nmfModel #' @examples #' #' # show all the NMF models available (i.e. the classes that inherit from class NMF) #' nmfModels() #' # show all the built-in NMF models available #' nmfModels(builtin.only=TRUE) #' nmfModels <- function(builtin.only=FALSE){ if( builtin.only ) return( .nmf.Models.Builtin ) # return all subclasses of class 'NMF' (minus class 'NMFfit' and its subclasses) models <- names(methods::getClass('NMF')@subclasses) models.wraps <- c('NMFfit', names(methods::getClass('NMFfit')@subclasses)) return( models[!is.element(models, models.wraps)] ) } ###% Initialization function for NMF models .nmf.Models.Builtin <- NULL .init.nmf.models <- function(){ .nmf.Models.Builtin <<- nmfModels() } NMF/R/registry-seed.R0000644000176000001440000000744512234465004014046 0ustar ripleyusers# 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, ...) } NMF/R/NMFstd-class.R0000644000176000001440000001756512234465004013522 0ustar ripleyusers# Class that implements the standard NMF model # # Author: Renaud Gaujoux \email{renaud@@cbio.uct.ac.za} ############################################################################### #' @include NMF-class.R NULL #' NMF Model - Standard model #' #' This class implements the standard model of Nonnegative Matrix #' Factorization. #' It provides a general structure and generic functions to manage #' factorizations that follow the standard NMF model, as defined by #' \cite{Lee2001}. #' #' Let \eqn{V} be a \eqn{n \times m} non-negative matrix and \eqn{r} a positive #' integer. In its standard form (see references below), a NMF of \eqn{V} is #' commonly defined as a pair of matrices \eqn{(W, H)} such that: #' #' \deqn{V \equiv W H,} #' #' where: #' \itemize{ #' \item \eqn{W} and \eqn{H} are \eqn{n \times r} and \eqn{r #' \times m} matrices respectively with non-negative entries; #' \item \eqn{\equiv} is to be understood with respect to some loss function. #' Common choices of loss functions are based on Frobenius norm or Kullback-Leibler #' divergence. #' } #' #' Integer \eqn{r} is called the \emph{factorization rank}. #' Depending on the context of application of NMF, the columns of \eqn{W} #' and \eqn{H} are given different names: #' \describe{ #' \item{columns of \code{W}}{basis vector, metagenes, factors, source, image basis} #' \item{columns of \code{H}}{mixture coefficients, metagene sample expression profiles, weights} #' \item{rows of \code{H}}{basis profiles, metagene expression profiles} #' } #' #' NMF approaches have been successfully applied to several fields. #' The package NMF was implemented trying to use names as generic as possible #' for objects and methods. #' #' The following terminology is used: #' \describe{ #' \item{samples}{the columns of the target matrix \eqn{V}} #' \item{features}{the rows of the target matrix \eqn{V}} #' \item{basis matrix}{the first matrix factor \eqn{W}} #' \item{basis vectors}{the columns of first matrix factor \eqn{W}} #' \item{mixture matrix}{the second matrix factor \eqn{H}} \item{mixtures #' coefficients}{the columns of second matrix factor \eqn{H}} #' } #' #' However, because the package NMF was primarily implemented to work with gene #' expression microarray data, it also provides a layer to easily and #' intuitively work with objects from the Bioconductor base framework. #' See \link{bioc-NMF} for more details. #' #' @slot W A \code{matrix} that contains the basis matrix, i.e. the \emph{first} #' matrix factor of the factorisation #' @slot H A \code{matrix} that contains the coefficient matrix, i.e. the #' \emph{second} matrix factor of the factorisation #' @slot bterms a \code{data.frame} that contains the primary data that #' define fixed basis terms. See \code{\link{bterms}}. #' @slot ibterms integer vector that contains the indexes of the basis components #' that are fixed, i.e. for which only the coefficient are estimated. #' #' IMPORTANT: This slot is set on construction of an NMF model via #' \code{\link[=nmfModel,formula,ANY-method]{nmfModel}} and is not recommended to #' not be subsequently changed by the end-user. #' @slot cterms a \code{data.frame} that contains the primary data that #' define fixed coefficient terms. See \code{\link{cterms}}. #' @slot icterms integer vector that contains the indexes of the basis components #' that have fixed coefficients, i.e. for which only the basis vectors are estimated. #' #' IMPORTANT: This slot is set on construction of an NMF model via #' \code{\link[=nmfModel,formula,ANY-method]{nmfModel}} and is not recommended to #' not be subsequently changed by the end-user. #' #' @export #' @family NMF-model #' @examples #' # create a completely empty NMFstd object #' new('NMFstd') #' #' # create a NMF object based on one random matrix: the missing matrix is deduced #' # Note this only works when using factory method NMF #' n <- 50; r <- 3; #' w <- rmatrix(n, r) #' nmfModel(W=w) #' #' # create a NMF object based on random (compatible) matrices #' p <- 20 #' h <- rmatrix(r, p) #' nmfModel(W=w, H=h) #' #' # create a NMF object based on incompatible matrices: generate an error #' h <- rmatrix(r+1, p) #' try( new('NMFstd', W=w, H=h) ) #' try( nmfModel(w, h) ) #' #' # Giving target dimensions to the factory method allow for coping with dimension #' # incompatibilty (a warning is thrown in such case) #' nmfModel(r, W=w, H=h) #' setClass('NMFstd' , representation( W = 'matrix' # basis matrix , H = 'matrix' # mixture coefficients matrix , bterms = 'data.frame' # fixed basis terms: nrow(bterms) = nrow(x) , ibterms = 'integer' # index of the fixed basis terms , cterms = 'data.frame' # fixed coef terms: ncol(cterms) = ncol(x) , icterms = 'integer' # index of the fixed coefficient terms ) , prototype = prototype( W = matrix(as.numeric(NA), 0, 0), H = matrix(as.numeric(NA), 0, 0) ) , validity = function(object){ # dimension compatibility: W and H must be compatible for matrix multiplication if( ncol(object@W) != nrow(object@H) ){ return(paste('Dimensions of W and H are not compatible [ncol(W)=', ncol(object@W) , '!= nrow(H)=', nrow(object@H), ']')) } # give a warning if the dimensions look strange: rank greater than the number of samples if( !is.empty.nmf(object) && ncol(object@H) && ncol(object@W) > ncol(object@H) ){ warning(paste('Dimensions of W and H look strange [ncol(W)=', ncol(object@W) , '> ncol(H)=', ncol(object@H), ']')) } # everything went fine: return TRUE return(TRUE) } , contains = 'NMF' ) #' Get the basis matrix in standard NMF models #' #' This function returns slot \code{W} of \code{object}. #' #' @examples #' # random standard NMF model #' x <- rnmf(3, 10, 5) #' basis(x) #' coef(x) #' #' # set matrix factors #' basis(x) <- matrix(1, nrow(x), nbasis(x)) #' coef(x) <- matrix(1, nbasis(x), ncol(x)) #' # set random factors #' basis(x) <- rmatrix(basis(x)) #' coef(x) <- rmatrix(coef(x)) #' #' # incompatible matrices generate an error: #' try( coef(x) <- matrix(1, nbasis(x)-1, nrow(x)) ) #' # but the low-level method allow it #' .coef(x) <- matrix(1, nbasis(x)-1, nrow(x)) #' try( validObject(x) ) #' setMethod('.basis', 'NMFstd', function(object){ object@W } ) #' Set the basis matrix in standard NMF models #' #' This function sets slot \code{W} of \code{object}. setReplaceMethod('.basis', signature(object='NMFstd', value='matrix'), function(object, value){ object@W <- value object } ) #' Get the mixture coefficient matrix in standard NMF models #' #' This function returns slot \code{H} of \code{object}. setMethod('.coef', 'NMFstd', function(object){ object@H } ) #' Set the mixture coefficient matrix in standard NMF models #' #' This function sets slot \code{H} of \code{object}. setReplaceMethod('.coef', signature(object='NMFstd', value='matrix'), function(object, value){ object@H <- value object } ) #' Compute the target matrix estimate in \emph{standard NMF models}. #' #' The estimate matrix is computed as the product of the two matrix slots #' \code{W} and \code{H}: #' \deqn{\hat{V} = W H}{V ~ W H} #' #' @param W a matrix to use in the computation as the basis matrix in place of #' \code{basis(object)}. #' It must be compatible with the coefficient matrix used #' in the computation (i.e. number of columns in \code{W} = number of rows in \code{H}). #' @param H a matrix to use in the computation as the coefficient matrix in place of #' \code{coef(object)}. #' It must be compatible with the basis matrix used #' in the computation (i.e. number of rows in \code{H} = number of columns in \code{W}). #' #' @export #' @inline #' #' @examples #' # random standard NMF model #' x <- rnmf(3, 10, 5) #' all.equal(fitted(x), basis(x) %*% coef(x)) #' #' setMethod('fitted', signature(object='NMFstd'), function(object, W, H, ...){ if( missing(W) ) W <- object@W if( missing(H) ) H <- object@H return(W %*% H) } ) NMF/R/NMFns-class.R0000644000176000001440000001364112234465004013337 0ustar ripleyusers#' @include NMFstd-class.R NULL #' NMF Model - Nonsmooth Nonnegative Matrix Factorization #' #' This class implements the \emph{Nonsmooth Nonnegative Matrix Factorization} #' (nsNMF) model, required by the Nonsmooth NMF algorithm. #' #' The Nonsmooth NMF algorithm is defined by \cite{Pascual-Montano2006} as a #' modification of the standard divergence based NMF algorithm (see section #' Details and references below). It aims at obtaining sparser factor #' matrices, by the introduction of a smoothing matrix. #' #' @details #' The Nonsmooth NMF algorithm is a modification of the standard divergence #' based NMF algorithm (see \code{\linkS4class{NMF}}). #' Given a non-negative \eqn{n \times p}{n x p} matrix \eqn{V} and a #' factorization rank \eqn{r}, it fits the following model: #' #' \deqn{V \equiv W S(\theta) H,}{V ~ W S(theta) H,} #' where: #' \itemize{ #' #' \item \eqn{W} and \eqn{H} are such as in the standard model, i.e. #' non-negative matrices of dimension \eqn{n \times r}{n x r} #' and \eqn{r \times p}{r x p} respectively; #' #' \item \eqn{S} is a \eqn{r \times r} square matrix whose entries depends on #' an extra parameter \eqn{0\leq \theta \leq 1} in the following way: #' \deqn{S = (1-\theta)I + \frac{\theta}{r} 11^T ,} #' where \eqn{I} is the identity matrix and \eqn{1} #' is a vector of ones. #' #' } #' #' The interpretation of S as a smoothing matrix can be explained as follows: #' Let \eqn{X} be a positive, nonzero, vector. Consider the transformed vector #' \eqn{Y = S X}. If \eqn{\theta = 0}, then \eqn{Y = X} and no smoothing on #' \eqn{X} has occurred. However, as \eqn{\theta \to 1}{theta tends to 1}, the #' vector \eqn{Y} tends to the constant vector with all elements almost equal #' to the average of the elements of \eqn{X}. This is the smoothest possible #' vector in the sense of non-sparseness because all entries are equal to the #' same nonzero value, instead of having some values close to zero and others #' clearly nonzero. #' #' @section Creating objects from the Class: #' #' Object of class \code{NMFns} can be created using the standard way with #' operator \code{\link{new}} #' #' However, as for all NMF model classes -- that extend class #' \code{\linkS4class{NMF}}, objects of class \code{NMFns} should be #' created using factory method \code{\link{nmfModel}} : #' #' \code{new('NMFns')} #' #' \code{nmfModel(model='NMFns')} #' #' \code{nmfModel(model='NMFns', W=w, theta=0.3} #' #' See \code{\link{nmfModel}} for more details on how to use the factory #' method. #' #' @section Algorithm: #' #' The Nonsmooth NMF algorithm uses a modified version of the multiplicative #' update equations in Lee & Seung's method for Kullback-Leibler divergence #' minimization. #' The update equations are modified to take into account the -- #' constant -- smoothing matrix. #' The modification reduces to using matrix \eqn{W S} instead of matrix \eqn{W} #' in the update of matrix \eqn{H}, and similarly using matrix \eqn{S H} #' instead of matrix \eqn{H} in the update of matrix \eqn{W}. #' #' After the matrix \eqn{W} has been updated, each of its columns is scaled so #' that it sums up to 1. #' #' @export #' @family NMF-model #' @examples #' #' # create a completely empty NMFns object #' new('NMFns') #' #' # create a NMF object based on random (compatible) matrices #' n <- 50; r <- 3; p <- 20 #' w <- rmatrix(n, r) #' h <- rmatrix(r, p) #' nmfModel(model='NMFns', W=w, H=h) #' #' # apply Nonsmooth NMF algorithm to a random target matrix #' V <- rmatrix(n, p) #' \dontrun{nmf(V, r, 'ns')} #' #' # random nonsmooth NMF model #' rnmf(3, 10, 5, model='NMFns', theta=0.3) #' setClass('NMFns' , representation( theta = 'numeric' # smoothing matrix ) , contains = 'NMFstd' , prototype = prototype( theta = 0.5 ) , validity = function(object){ if( object@theta < 0 || object@theta > 1 ) return(paste("Invalid value for theta (",object@theta,"): must be between 0 and 1", sep='')) TRUE } ) #' Show method for objects of class \code{NMFns} #' @export setMethod('show', 'NMFns', function(object) { callNextMethod() cat("theta:", object@theta, "\n") } ) #' Compute estimate for an NMFns object, according to the Nonsmooth NMF model #' (cf. \code{\link{NMFns-class}}). #' #' Extra arguments in \code{...} are passed to method \code{smoothing}, and are #' typically used to pass a value for \code{theta}, which is used to compute #' the smoothing matrix instead of the one stored in \code{object}. #' #' @param S smoothing matrix to use instead of \code{smoothing(object)} #' It must be a square matrix compatible with the basis and coefficient matrices #' used in the computation. #' @inline #' setMethod('fitted', signature(object='NMFns'), function(object, W, H, S, ...){ if( missing(W) ) W <- object@W if( missing(H) ) H <- object@H if( missing(S) ) S <- smoothing(object, ...) W %*% (S %*% H) } ) #' Smoothing Matrix in Nonsmooth NMF Models #' #' The function \code{smoothing} builds a smoothing matrix for using in Nonsmooth #' NMF models. #' #' For a \eqn{r}-rank NMF, the smoothing matrix of parameter \eqn{\theta} is #' built as follows: #' \deqn{S = (1-\theta)I + \frac{\theta}{r} 11^T ,} #' where \eqn{I} is the identity matrix and \eqn{1} is a vector of ones #' (cf. \code{\link{NMFns-class}} for more details). #' #' @param x a object of class \code{NMFns}. #' @param theta the smoothing parameter (numeric) between 0 and 1. #' @param ... extra arguments to allow extension (not used) #' #' @return if \code{x} estimates a \eqn{r}-rank NMF, #' then the result is a \eqn{r \times r} square matrix. #' @export #' #' @examples #' x <- nmfModel(3, model='NMFns') #' smoothing(x) #' smoothing(x, 0.1) #' smoothing <- function(x, theta=x@theta, ...){ # check validity of theta if( theta < 0 || theta > 1 ) stop("Invalid smoothing parameter theta [",theta,"]: theta must be susch that 0 <= theta <=1") diag(1-theta, nbasis(x)) + theta / nbasis(x) } NMF/R/aheatmap.R0000644000176000001440000021727612530677614013060 0ustar ripleyusers#' @include atracks.R #' @include grid.R #' @include colorcode.R NULL library(grid) library(gridBase) # extends gpar objects c_gpar <- function(gp, ...){ x <- list(...) do.call(gpar, c(gp, x[!names(x) %in% names(gp)])) } lo <- function (rown, coln, nrow, ncol, cellheight = NA, cellwidth = NA , treeheight_col, treeheight_row, legend, main = NULL, sub = NULL, info = NULL , annTracks, annotation_legend , fontsize, fontsize_row, fontsize_col, gp = gpar()){ annotation_colors <- annTracks$colors row_annotation <- annTracks$annRow annotation <- annTracks$annCol gp0 <- gp coln_height <- unit(10, "bigpts") if(!is.null(coln)){ longest_coln = which.max(nchar(coln)) coln_height <- coln_height + unit(1.1, "grobheight", textGrob(coln[longest_coln], rot = 90, gp = c_gpar(gp, fontsize = fontsize_col))) } rown_width <- rown_width_min <- unit(10, "bigpts") if(!is.null(rown)){ longest_rown = which.max(nchar(rown)) rown_width <- rown_width_min + unit(1.2, "grobwidth", textGrob(rown[longest_rown], gp = c_gpar(gp, fontsize = fontsize_row))) } gp = c_gpar(gp, fontsize = fontsize) # Legend position if( !is_NA(legend) ){ longest_break = which.max(nchar(as.character(legend))) longest_break = unit(1.1, "grobwidth", textGrob(as.character(legend)[longest_break], gp = gp)) # minimum fixed width: plan for 2 decimals and a sign min_lw = unit(1.1, "grobwidth", textGrob("-00.00", gp = gp)) longest_break = max(longest_break, min_lw) title_length = unit(1.1, "grobwidth", textGrob("Scale", gp = c_gpar(gp0, fontface = "bold"))) legend_width = unit(12, "bigpts") + longest_break * 1.2 legend_width = max(title_length, legend_width) } else{ legend_width = unit(0, "bigpts") } .annLegend.dim <- function(annotation, fontsize){ # Width of the corresponding legend longest_ann <- unlist(lapply(annotation, names)) longest_ann <- longest_ann[which.max(nchar(longest_ann))] annot_legend_width = unit(1, "grobwidth", textGrob(longest_ann, gp = gp)) + unit(10, "bigpts") # width of the legend title annot_legend_title <- names(annotation)[which.max(nchar(names(annotation)))] annot_legend_title_width = unit(1, "grobwidth", textGrob(annot_legend_title, gp = c_gpar(gp, fontface = "bold"))) # total width max(annot_legend_width, annot_legend_title_width) + unit(5, "bigpts") } # Column annotations if( !is_NA(annotation) ){ # Column annotation height annot_height = unit(ncol(annotation) * (8 + 2) + 2, "bigpts") } else{ annot_height = unit(0, "bigpts") } # add a viewport for the row annotations if ( !is_NA(row_annotation) ) { # Row annotation width row_annot_width = unit(ncol(row_annotation) * (8 + 2) + 2, "bigpts") } else { row_annot_width = unit(0, "bigpts") } # Width of the annotation legend annot_legend_width <- if( annotation_legend && !is_NA(annotation_colors) ){ .annLegend.dim(annotation_colors, fontsize) }else unit(0, "bigpts") # Tree height treeheight_col = unit(treeheight_col, "bigpts") + unit(5, "bigpts") treeheight_row = unit(treeheight_row, "bigpts") + unit(5, "bigpts") # main title main_height <- if(!is.null(main)) unit(1, "grobheight", main) + unit(20, "bigpts") else unit(0, "bigpts") # sub title sub_height <- if(!is.null(sub)) unit(1, "grobheight", sub) + unit(10, "bigpts") else unit(0, "bigpts") # info panel if( !is.null(info) ){ info_height <- unit(1, "grobheight", info) + unit(20, "bigpts") info_width <- unit(1, "grobwidth", info) + unit(10, "bigpts") }else{ info_height <- unit(0, "bigpts") info_width <- unit(0, "bigpts") } # Set cell sizes if(is.na(cellwidth)){ matwidth = unit(1, "npc") - rown_width - legend_width - row_annot_width - treeheight_row - annot_legend_width } else{ matwidth = unit(cellwidth * ncol, "bigpts") } if(is.na(cellheight)){ matheight = unit(1, "npc") - treeheight_col - annot_height - main_height - coln_height - sub_height - info_height # recompute the cell width depending on the automatic fontsize if( is.na(cellwidth) && !is.null(rown) ){ cellheight <- convertHeight(unit(1, "grobheight", rectGrob(0,0, matwidth, matheight)), "bigpts", valueOnly = T) / nrow fontsize_row <- convertUnit(min(unit(fontsize_row, 'points'), unit(0.6*cellheight, 'bigpts')), 'points') rown_width <- rown_width_min + unit(1.2, "grobwidth", textGrob(rown[longest_rown], gp = c_gpar(gp0, fontsize = fontsize_row))) matwidth <- unit(1, "npc") - rown_width - legend_width - row_annot_width - treeheight_row - annot_legend_width } } else{ matheight = unit(cellheight * nrow, "bigpts") } # HACK: # - use 6 instead of 5 column for the row_annotation # - take into account the associated legend's width # Produce layout() unique.name <- vplayout(NULL) lo <- grid.layout(nrow = 7, ncol = 6 , widths = unit.c(treeheight_row, row_annot_width, matwidth, rown_width, legend_width, annot_legend_width) , heights = unit.c(main_height, treeheight_col, annot_height, matheight, coln_height, sub_height, info_height)) hvp <- viewport( name=paste('aheatmap', unique.name, sep='-'), layout = lo) pushViewport(hvp) #grid.show.layout(lo); stop('sas') # Get cell dimensions vplayout('mat') cellwidth = convertWidth(unit(1, "npc"), "bigpts", valueOnly = T) / ncol cellheight = convertHeight(unit(1, "npc"), "bigpts", valueOnly = T) / nrow upViewport() height <- as.numeric(convertHeight(sum(lo$height), "inches")) width <- as.numeric(convertWidth(sum(lo$width), "inches")) # Return minimal cell dimension in bigpts to decide if borders are drawn mindim = min(cellwidth, cellheight) return( list(width=width, height=height, vp=hvp, mindim=mindim, cellwidth=cellwidth, cellheight=cellheight) ) } draw_dendrogram = function(hc, horizontal = T){ # .draw.dendrodram <- function(hc){ # # # convert into an hclust if necessary # if( is(hc, 'dendrogram') ){ # hca <- attr(hc, 'hclust') # hc <- if( !is.null(hca) ) hca else as.hclust(hc) # } # # h = hc$height / max(hc$height) / 1.05 # m = hc$merge # o = hc$order # n = length(o) # # m[m > 0] = n + m[m > 0] # m[m < 0] = abs(m[m < 0]) # # dist = matrix(0, nrow = 2 * n - 1, ncol = 2, dimnames = list(NULL, c("x", "y"))) # dist[1:n, 1] = 1 / n / 2 + (1 / n) * (match(1:n, o) - 1) # # for(i in 1:nrow(m)){ # dist[n + i, 1] = (dist[m[i, 1], 1] + dist[m[i, 2], 1]) / 2 # dist[n + i, 2] = h[i] # } # # draw_connection = function(x1, x2, y1, y2, y){ # grid.lines(x = c(x1, x1), y = c(y1, y)) # grid.lines(x = c(x2, x2), y = c(y2, y)) # grid.lines(x = c(x1, x2), y = c(y, y)) # } # # # create a rotating viewport for vertical dendrogram # if(!horizontal){ # gr = rectGrob() # pushViewport(viewport(height = unit(1, "grobwidth", gr), width = unit(1, "grobheight", gr), angle = 90)) # on.exit(upViewport()) # } # # for(i in 1:nrow(m)){ # draw_connection(dist[m[i, 1], 1], dist[m[i, 2], 1], dist[m[i, 1], 2], dist[m[i, 2], 2], h[i]) # } # # } .draw.dendrodram <- function(hc, ...){ # suppressWarnings( opar <- par(plt = gridPLT(), new = TRUE) ) ( opar <- par(plt = gridPLT(), new = TRUE) ) on.exit(par(opar)) if( getOption('verbose') ) grid.rect(gp = gpar(col = "blue", lwd = 2)) if( !is(hc, 'dendrogram') ) hc <- as.dendrogram(hc) plot(hc, horiz=!horizontal, xaxs="i", yaxs="i", axes=FALSE, leaflab="none", ...) } # create a margin viewport if(!horizontal) pushViewport( viewport(x=0,y=0,width=0.9,height=1,just=c("left", "bottom")) ) else pushViewport( viewport(x=0,y=0.1,width=1,height=0.9,just=c("left", "bottom")) ) on.exit(upViewport()) .draw.dendrodram(hc) } # draw a matrix first row at bottom, last at top draw_matrix = function(matrix, border_color, txt = NULL, gp = gpar()){ n = nrow(matrix) m = ncol(matrix) x = (1:m)/m - 1/2/m y = (1:n)/n - 1/2/n # substitute NA values with empty strings if( !is.null(txt) ) txt[is.na(txt)] <- '' for(i in 1:m){ grid.rect(x = x[i], y = y, width = 1/m, height = 1/n, gp = gpar(fill = matrix[,i], col = border_color)) if( !is.null(txt) ){ grid.text(label=txt[, i], x=x[i], y=y, # just=just, # hjust=hjust, # vjust=vjust, rot=0, check.overlap= FALSE, #check.overlap, default.units= 'npc', #default.units, # name=name, gp=gp, # draw=draw, # vp=vp ) } } } draw_colnames = function(coln, gp = gpar()){ m = length(coln) # decide on the label orientation width <- m * unit(1, "grobwidth", textGrob(coln[i <- which.max(nchar(coln))], gp = gp)) width <- as.numeric(convertWidth(width, "inches")) gwidth <- as.numeric(convertWidth(unit(1, 'npc'), "inches")) y <- NULL if( gwidth < width ){ rot <- 270 vjust <- 0.5 hjust <- 0 y <- unit(1, 'npc') - unit(5, 'bigpts') }else{ rot <- 0 vjust <- 0.5 hjust <- 0.5 } if( is.null(y) ){ height <- unit(1, "grobheight", textGrob(coln[i], vjust = vjust, hjust = hjust, rot=rot, gp = gp)) y <- unit(1, 'npc') - height } x = (1:m)/m - 1/2/m grid.text(coln, x = x, y = y, vjust = vjust, hjust = hjust, rot=rot, gp = gp) } # draw rownames first row at bottom, last on top draw_rownames = function(rown, gp = gpar()){ n = length(rown) y = (1:n)/n - 1/2/n grid.text(rown, x = unit(5, "bigpts"), y = y, vjust = 0.5, hjust = 0, gp = gp) } draw_legend = function(color, breaks, legend, gp = gpar()){ height = min(unit(1, "npc"), unit(150, "bigpts")) pushViewport(viewport(x = 0, y = unit(1, "npc"), just = c(0, 1), height = height)) legend_pos = (legend - min(breaks)) / (max(breaks) - min(breaks)) breaks = (breaks - min(breaks)) / (max(breaks) - min(breaks)) h = breaks[-1] - breaks[-length(breaks)] grid.rect(x = 0, y = breaks[-length(breaks)], width = unit(10, "bigpts"), height = h, hjust = 0, vjust = 0, gp = gpar(fill = color, col = "#FFFFFF00")) grid.text(legend, x = unit(12, "bigpts"), y = legend_pos, hjust = 0, gp = gp) upViewport() } convert_annotations = function(annotation, annotation_colors){ #new = annotation x <- sapply(seq_along(annotation), function(i){ #for(i in 1:length(annotation)){ a = annotation[[i]] b <- attr(a, 'color') if( is.null(b) ) b = annotation_colors[[names(annotation)[i]]] if(class(a) %in% c("character", "factor")){ a = as.character(a) #print(names(b)) #print(unique(a)) if ( FALSE && length(setdiff(names(b), a)) > 0){ stop(sprintf("Factor levels on variable %s do not match with annotation_colors", names(annotation)[i])) } #new[, i] = b[a] b[match(a, names(b))] } else{ a = cut(a, breaks = 100) #new[, i] = colorRampPalette(b)(100)[a] ccRamp(b, 100)[a] } }) colnames(x) <- names(annotation) return(x) #return(as.matrix(new)) } draw_annotations = function(converted_annotations, border_color, horizontal=TRUE){ n = ncol(converted_annotations) m = nrow(converted_annotations) if( horizontal ){ x = (1:m)/m - 1/2/m y = cumsum(rep(8, n)) - 4 + cumsum(rep(2, n)) for(i in 1:m){ grid.rect(x = x[i], unit(y[n:1], "bigpts"), width = 1/m, height = unit(8, "bigpts"), gp = gpar(fill = converted_annotations[i, ], col = border_color)) } }else{ x = cumsum(rep(8, n)) - 4 + cumsum(rep(2, n)) y = (1:m)/m - 1/2/m for (i in 1:m) { grid.rect(x = unit(x[1:n], "bigpts"), y=y[i], width = unit(8, "bigpts"), height = 1/m, gp = gpar(fill = converted_annotations[i,] , col = border_color)) } } } draw_annotation_legend = function(annotation_colors, border_color, gp = gpar()){ y = unit(1, "npc") text_height = convertHeight(unit(1, "grobheight", textGrob("FGH", gp = gp)), "bigpts") for(i in names(annotation_colors)){ grid.text(i, x = 0, y = y, vjust = 1, hjust = 0, gp = c_gpar(gp, fontface = "bold")) y = y - 1.5 * text_height #if(class(annotation[[i]]) %in% c("character", "factor")){ acol <- annotation_colors[[i]] if( attr(acol, 'afactor') ){ sapply(seq_along(acol), function(j){ grid.rect(x = unit(0, "npc"), y = y, hjust = 0, vjust = 1, height = text_height, width = text_height, gp = gpar(col = border_color, fill = acol[j])) grid.text(names(acol)[j], x = text_height * 1.3, y = y, hjust = 0, vjust = 1, gp = gp) y <<- y - 1.5 * text_height }) } else{ yy = y - 4 * text_height + seq(0, 1, 0.01) * 4 * text_height h = 4 * text_height * 0.02 grid.rect(x = unit(0, "npc"), y = yy, hjust = 0, vjust = 1, height = h, width = text_height, gp = gpar(col = "#FFFFFF00", fill = ccRamp(acol, 100))) txt = c(tail(names(acol),1), head(names(acol))[1]) yy = y - c(0, 3) * text_height grid.text(txt, x = text_height * 1.3, y = yy, hjust = 0, vjust = 1, gp = gp) y = y - 4.5 * text_height } y = y - 1.5 * text_height } } vplayout <- function () { graphic.name <- NULL .index <- 0L function(x, y, verbose = getOption('verbose') ){ # initialize the graph name if( is.null(x) ){ .index <<- .index + 1L graphic.name <<- paste0("AHEATMAP.VP.", .index) #grid:::vpAutoName() return(graphic.name) } name <- NULL if( !is.numeric(x) ){ name <- paste(graphic.name, x, sep='-') if( !missing(y) && is(y, 'viewport') ){ y$name <- name return(pushViewport(y)) } if( !is.null(tryViewport(name, verbose=verbose)) ) return() switch(x , main={x<-1; y<-3;} , ctree={x<-2; y<-3;} , cann={x<-3; y<-3;} , rtree={x<-4; y<-1;} , rann={x<-4; y<-2;} , mat={x<-4; y<-3;} , rnam={x<-4; y<-4;} , leg={x<-4; y<-5;} , aleg={x<-4; y<-6;} , cnam={x<-5; y<-3;} , sub={x<-6; y<-3;} , info={x<-7; y<-3;} , stop("aheatmap - invalid viewport name") ) } if( verbose ) message("vp - create ", name) pushViewport(viewport(layout.pos.row = x, layout.pos.col = y, name=name)) } } vplayout <- vplayout() #' Open a File Graphic Device #' #' Opens a graphic device depending on the file extension #' #' @keywords internal gfile <- function(filename, width, height, ...){ # Get file type r = regexpr("\\.[a-zA-Z]*$", filename) if(r == -1) stop("Improper filename") ending = substr(filename, r + 1, r + attr(r, "match.length")) f = switch(ending, pdf = function(x, ...) pdf(x, ...), svg = function(x, ...) svg(x, ...), png = function(x, ...) png(x, ...), jpeg = function(x, ...) jpeg(x, ...), jpg = function(x, ...) jpeg(x, ...), tiff = function(x, ...) tiff(x, compression = "lzw", ...), bmp = function(x, ...) bmp(x, ...), stop("File type should be: pdf, svg, png, bmp, jpg, tiff") ) args <- c(list(filename), list(...)) if( !missing(width) ){ args$width <- as.numeric(width) args$height <- as.numeric(height) if( !ending %in% c('pdf','svg') && is.null(args[['res']]) ){ args$units <- "in" args$res <- 300 } } do.call('f', args) } #gt <- function(){ # # x <- rmatrix(20, 10) # z <- unit(0.1, "npc") # w <- unit(0.4, "npc") # h <- unit(0.3, "npc") # lo <- grid.layout(nrow = 7, ncol = 6 # , widths = unit.c(z, z, w, z, z, z) # , heights = unit.c(z, z, z, h, z, z, z)) # # nvp <- 0 # on.exit( upViewport(nvp) ) # # u <- vplayout(NULL) # vname <- function(x) basename(tempfile(x)) # # hvp <- viewport( name=u, layout = lo) # pushViewport(hvp) # nvp <- nvp + 1 # # pushViewport(viewport(layout.pos.row = 4, layout.pos.col = 3, name='test')) # #vplayout('mat') # nvp <- nvp + 1 # # grid.rect() # NULL #} #gt2 <- function(){ # # x <- rmatrix(10, 5) # lo(NULL, NULL, nrow(x), ncol(x), cellheight = NA, cellwidth = NA # , treeheight_col=0, treeheight_row=0, legend=FALSE, main = NULL, sub = NULL, info = NULL # , annTracks=list(colors=NA, annRow=NA, annCol=NA), annotation_legend=FALSE # , fontsize=NULL, fontsize_row=NULL, fontsize_col=NULL) # # #vplayout('mat') # vname <- function(x) basename(tempfile(x)) # pushViewport(viewport(layout.pos.row = 4, layout.pos.col = 3, name=vname('test'))) # print(current.vpPath()) # grid.rect() # upViewport(2) # NULL #} d <- function(x){ if( is.character(x) ) x <- rmatrix(dim(x)) nvp <- 0 on.exit(upViewport(nvp), add=TRUE) lo <- grid.layout(nrow = 4, ncol = 3) hvp <- viewport( name=basename(tempfile()), layout = lo) pushViewport(hvp) nvp <- nvp + 1 pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 1)) nvp <- nvp + 1 w = convertWidth(unit(1, "npc"), "bigpts", valueOnly = T) / 10 h = convertHeight(unit(1, "npc"), "bigpts", valueOnly = T) / 10 grid.rect() upViewport() nvp <- nvp - 1 pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 2)) nvp <- nvp + 1 # add inner padding viewport pushViewport( viewport(x=0,y=0,width=0.9,height=0.9,just=c("left", "bottom")) ) nvp <- nvp + 1 ( opar <- par(plt = gridPLT(), new = TRUE) ) on.exit(par(opar), add=TRUE) hc <- hclust(dist(x)) plot(as.dendrogram(hc), xaxs="i", yaxs="i", axes=FALSE, leaflab="none") invisible(basename(tempfile())) } heatmap_motor = function(matrix, border_color, cellwidth, cellheight , tree_col, tree_row, treeheight_col, treeheight_row , filename=NA, width=NA, height=NA , breaks, color, legend, txt = NULL , annTracks, annotation_legend=TRUE , new=TRUE, fontsize, fontsize_row, fontsize_col , main=NULL, sub=NULL, info=NULL , verbose=getOption('verbose') , gp = gpar()){ annotation_colors <- annTracks$colors row_annotation <- annTracks$annRow annotation <- annTracks$annCol writeToFile <- !is.na(filename) # open graphic device (dimensions will be changed after computation of the correct height) if( writeToFile ){ gfile(filename) on.exit(dev.off()) } # identify the plotting context: base or grid #NB: use custom function current.vpPath2 instead of official # grid::current.vpPath as this one creates a new page when called # on a fresh graphic device vpp <- current.vpPath_patched() if( is.null(vpp) ){ # we are at the root viewport if( verbose ) message("Detected path: [ROOT]") mf <- par('mfrow') #print(mf) # if in in mfrow/layout context: setup fake-ROOT viewports with gridBase # and do not call plot.new as it is called in grid.base.mix. new <- if( !identical(mf, c(1L,1L)) ){ if( verbose ) message("Detected mfrow: ", mf[1], " - ", mf[2], ' ... MIXED') opar <- grid.base.mix(trace=verbose>1) on.exit( grid.base.mix(opar) ) FALSE } else{ if( verbose ){ message("Detected mfrow: ", mf[1], " - ", mf[2]) message("Honouring ", if( missing(new) ) "default " ,"argument `new=", new, '` ... ' , if( new ) "NEW" else "OVERLAY") } new } }else{ if( verbose ) message("Detected path: ", vpp) # if new is not specified: change the default behaviour by not calling # plot.new so that drawing occurs in the current viewport if( missing(new) ){ if( verbose ) message("Missing argument `new` ... OVERLAY") new <- FALSE }else if( verbose ) message("Honouring argument `new=", new, '` ... ' , if( new ) "NEW" else "OVERLAY") } # reset device if necessary or requested if( new ){ if( verbose ) message("Call: plot.new") #grid.newpage() plot.new() } # define grob for main mainGrob <- if( !is.null(main) && !is.grob(main) ) textGrob(main, gp = c_gpar(gp, fontsize = 1.2 * fontsize, fontface="bold")) subGrob <- if( !is.null(sub) && !is.grob(sub) ) textGrob(sub, gp = c_gpar(gp, fontsize = 0.8 * fontsize)) infoGrob <- if( !is.null(info) && !is.grob(info) ){ # infotxt <- paste(strwrap(paste(info, collapse=" | "), width=20), collapse="\n") grobTree(gList(rectGrob(gp = gpar(fill = "grey80")) ,textGrob(paste(info, collapse=" | "), x=unit(5, 'bigpts'), y=0.5, just='left', gp = c_gpar(gp, fontsize = 0.8 * fontsize)))) } # Set layout glo = lo(coln = colnames(matrix), rown = rownames(matrix), nrow = nrow(matrix), ncol = ncol(matrix) , cellwidth = cellwidth, cellheight = cellheight , treeheight_col = treeheight_col, treeheight_row = treeheight_row , legend = legend , annTracks = annTracks, annotation_legend = annotation_legend , fontsize = fontsize, fontsize_row = fontsize_row, fontsize_col = fontsize_col , main = mainGrob, sub = subGrob, info = infoGrob, gp = gp) # resize the graphic file device if necessary if( writeToFile ){ if( verbose ) message("Compute size for file graphic device") m <- par('mar') if(is.na(height)) height <- glo$height if(is.na(width)) width <- glo$width dev.off() if( verbose ) message("Resize file graphic device to: ", width, " - ", height) gfile(filename, width=width, height=height) # re-call plot.new if it was called before if( new ){ if( verbose ) message("Call again plot.new") op <- par(mar=c(0,0,0,0)) plot.new() par(op) } if( verbose ) message("Push again top viewport") # repush the layout pushViewport(glo$vp) if( verbose ) grid.rect(width=unit(glo$width, 'inches'), height=unit(glo$height, 'inches'), gp = gpar(col='blue')) } #grid.show.layout(glo$layout); return() mindim <- glo$mindim # Omit border color if cell size is too small if(mindim < 3) border_color = NA # Draw tree for the columns if (!is_NA(tree_col) && treeheight_col != 0){ #vplayout(1, 2) vplayout('ctree') draw_dendrogram(tree_col, horizontal = T) upViewport() } # Draw tree for the rows if(!is_NA(tree_row) && treeheight_row !=0){ #vplayout(3, 1) vplayout('rtree') draw_dendrogram(tree_row, horizontal = F) upViewport() } # recompute margin fontsizes fontsize_row <- convertUnit(min(unit(fontsize_row, 'points'), unit(0.6*glo$cellheight, 'bigpts')), 'points') fontsize_col <- convertUnit(min(unit(fontsize_col, 'points'), unit(0.6*glo$cellwidth, 'bigpts')), 'points') # Draw matrix #vplayout(3, 2) vplayout('mat') draw_matrix(matrix, border_color, txt = txt, gp = gpar(fontsize = fontsize_row)) #d(matrix) #grid.rect() upViewport() # Draw colnames if(length(colnames(matrix)) != 0){ #vplayout(4, 2) vplayout('cnam') draw_colnames(colnames(matrix), gp = c_gpar(gp, fontsize = fontsize_col)) upViewport() } # Draw rownames if(length(rownames(matrix)) != 0){ #vplayout(3, 3) vplayout('rnam') draw_rownames(rownames(matrix), gp = c_gpar(gp, fontsize = fontsize_row)) upViewport() } # Draw annotation tracks if( !is_NA(annotation) ){ #vplayout(2, 2) vplayout('cann') draw_annotations(annotation, border_color) upViewport() } # add row annotations if necessary if ( !is_NA(row_annotation) ) { vplayout('rann') draw_annotations(row_annotation, border_color, horizontal=FALSE) upViewport() } # Draw annotation legend if( annotation_legend && !is_NA(annotation_colors) ){ #vplayout(3, 5) vplayout('aleg') draw_annotation_legend(annotation_colors, border_color, gp = c_gpar(gp, fontsize = fontsize)) upViewport() } # Draw legend if(!is_NA(legend)){ #vplayout(3, 4) vplayout('leg') draw_legend(color, breaks, legend, gp = c_gpar(gp, fontsize = fontsize)) upViewport() } # Draw main if(!is.null(mainGrob)){ vplayout('main') grid.draw(mainGrob) upViewport() } # Draw subtitle if(!is.null(subGrob)){ vplayout('sub') grid.draw(subGrob) upViewport() } # Draw info if(!is.null(infoGrob)){ vplayout('info') grid.draw(infoGrob) upViewport() } # return current vp tree #ct <- current.vpTree() #print(current.vpPath()) upViewport() #popViewport() # grab current grob and return # gr <- grid.grab() # grid.draw(gr) #ct NULL } generate_breaks = function(x, n, center=NA){ if( missing(center) || is_NA(center) ) seq(min(x, na.rm = T), max(x, na.rm = T), length.out = n + 1) else{ # center the breaks on the requested value n2 <- ceiling((n+0.5)/2) M <- max(abs(center - min(x, na.rm = TRUE)), abs(center - max(x, na.rm = TRUE))) lb <- seq(center-M, center, length.out = n2) rb <- seq(center, center+M, length.out = n2) c(lb, rb[-1]) } } scale_vec_colours = function(x, col = rainbow(10), breaks = NA){ return(col[as.numeric(cut(x, breaks = breaks, include.lowest = T))]) } scale_colours = function(mat, col = rainbow(10), breaks = NA){ mat = as.matrix(mat) return(matrix(scale_vec_colours(as.vector(mat), col = col, breaks = breaks), nrow(mat), ncol(mat), dimnames = list(rownames(mat), colnames(mat)))) } cutheight <- function(x, n){ # exit early if n <=1: nothing to do if( n <=1 ) return( attr(x, 'height') ) res <- NULL .heights <- function(subtree, n){ if( is.leaf(subtree) ) return() if (!(K <- length(subtree))) stop("non-leaf subtree of length 0") # extract heights from each subtree for( k in 1:K){ res <<- c(res, attr(subtree[[k]], 'height')) } # continue only if there is not yet enough subtrees if( length(res) < n ){ for( k in 1:K){ .heights(subtree[[k]], n) } } } # extract at least the top h heights .heights(x, n) # sort by decreasing order res <- sort(res, decreasing=TRUE) res[n-1] } #' Fade Out the Upper Branches from a Dendrogram #' #' @param x a dendrogram #' @param n the number of groups #' #' @import digest #' @keywords internal cutdendro <- function(x, n){ # exit early if n <=1: nothing to do if( n <= 1 ) return(x) # add node digest ids to x x <- dendrapply(x, function(n){ attr(n, 'id') <- digest(attributes(n)) n }) # cut x in n groups # find the height where to cut h <- cutheight(x, n) cfx <- cut(x, h) # get the ids of the upper nodes ids <- sapply(cfx$lower, function(sub) attr(sub, 'id')) # highlight the upper branches with dot lines dts <- c(lty=2, lwd=1.2, col=8) a <- dendrapply(x, function(node){ a <- attributes(node) if( a$id %in% ids || (!is.leaf(node) && any(c(attr(node[[1]], 'id'), attr(node[[2]], 'id')) %in% ids)) ) attr(node, 'edgePar') <- dts node }) } # internal class definition for as_treedef <- function(x, ...){ res <- if( is(x, 'hclust') ) list(dendrogram=as.dendrogram(x), dist.method=x$dist.method, method=x$method) else list(dendrogram=x, ...) class(res) <- "aheatmap_treedef" res } rev.aheatmap_treedef <- function(x){ x$dendrogram <- rev(x$dendrogram) x } is_treedef <- function(x) is(x, 'aheatmap_treedef') isLogical <- function(x) isTRUE(x) || identical(x, FALSE) # Convert an index vector usable on the subset data into one usable on the # original data subset2orginal_idx <- function(idx, subset){ if( is.null(subset) || is.null(idx) ) idx else{ res <- subset[idx] attr(res, 'subset') <- idx res } } #' Cluster Matrix Rows in Annotated Heatmaps #' #' @param mat original input matrix that has already been appropriately subset in #' the caller function (\code{aheatmap}) #' @param param clustering specifications #' @param distfun Default distance method/function #' @param hclustfun Default clustering (linkage) method/function #' @param reorderfun Default reordering function #' @param na.rm Logical that specifies if NA values should be removed #' @param subset index (integer) vector specifying the subset indexes used to #' subset mat. This is required to be able to return the original indexes. #' #' @keywords internal cluster_mat = function(mat, param, distfun, hclustfun, reorderfun, na.rm=TRUE, subset=NULL, verbose = FALSE){ # do nothing if an hclust object is passed parg <- deparse(substitute(param)) Rowv <- if( is(param, 'hclust') || is(param, 'dendrogram') ){ # hclust or dendrograms are honoured res <- as_treedef(param) # subset if requested: convert into an index vector # the actuval subsetting is done by first case (index vector) if( !is.null(subset) ){ warning("Could not directly subset dendrogram/hclust object `", parg ,"`: using subset of the dendrogram's order instead.") # use dendrogram order instead of dendrogram itself param <- order.dendrogram(res$dendrogram) }else # EXIT: return treedef return(res) }else if( is(param, 'silhouette') ){ # use silhouette order si <- sortSilhouette(param) param <- attr(si, 'iOrd') } # index vectors are honoured if( is.integer(param) && length(param) > 1 ){ # subset if requested: reorder the subset indexes as in param if( !is.null(subset) ) param <- order(match(subset, param)) param }else{ # will compute dendrogram (NB: mat was already subset before calling cluster_mat) param <- if( is.integer(param) ) param else if( is.null(param) || isLogical(param) ) # use default reordering by rowMeans rowMeans(mat, na.rm=na.rm) else if( is.numeric(param) ){ # numeric reordering weights # subset if necessary if( !is.null(subset) ) param <- param[subset] param }else if( is.character(param) || is.list(param) ){ if( length(param) == 0 ) stop("aheatmap - Invalid empty character argument `", parg, "`.") # set default names if no names were provided if( is.null(names(param)) ){ if( length(param) > 3 ){ warning("aheatmap - Only using the three first elements of `", parg, "` for distfun and hclustfun respectively.") param <- param[1:3] } n.allowed <- c('distfun', 'hclustfun', 'reorderfun') names(param) <- head(n.allowed, length(param)) } # use the distance passed in param if( 'distfun' %in% names(param) ) distfun <- param[['distfun']] # use the clustering function passed in param if( 'hclustfun' %in% names(param) ) hclustfun <- param[['hclustfun']] # use the reordering function passed in param if( 'reorderfun' %in% names(param) ) reorderfun <- param[['reorderfun']] TRUE }else stop("aheatmap - Invalid value for argument `", parg, "`. See ?aheatmap.") # compute distances d <- if( isString(distfun) ){ distfun <- distfun[1] corr.methods <- c("pearson", "kendall", "spearman") av <- c("correlation", corr.methods, "euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski") i <- pmatch(distfun, av) if( is_NA(i) ) stop("aheatmap - Invalid dissimilarity method, must be one of: ", str_out(av, Inf)) distfun <- av[i] if(distfun == "correlation") distfun <- 'pearson' if(distfun %in% corr.methods){ # distance from correlation matrix if( verbose ) message("Using distance method: correlation (", distfun, ')') d <- dist(1 - cor(t(mat), method = distfun)) attr(d, 'method') <- distfun d }else{ if( verbose ) message("Using distance method: ", distfun) dist(mat, method = distfun) } }else if( is(distfun, "dist") ){ if( verbose ) message("Using dist object: ", distfun) distfun }else if( is.function(distfun) ){ if( verbose ) message("Using custom dist function") distfun(mat) }else stop("aheatmap - Invalid dissimilarity function: must be a character string, an object of class 'dist', or a function") # do hierarchical clustering hc <- if( is.character(hclustfun) ){ av <- c('ward', 'single', 'complete', 'average', 'mcquitty', 'median', 'centroid') i <- pmatch(hclustfun, av) if( is.na(i) ) stop("aheatmap - Invalid clustering method, must be one of: ", paste("'", av, "'", sep='', collapse=', ')) hclustfun <- av[i] if( verbose ) message("Using clustering method: ", hclustfun) hclust(d, method=hclustfun) }else if( is.function(hclustfun) ) hclustfun(d) else stop("aheatmap - Invalid clustering function: must be a character string or a function") #convert into a dendrogram dh <- as.dendrogram(hc) # customize the dendrogram plot: highlight clusters if( is.integer(param) ) dh <- cutdendro(dh, param) else if( is.numeric(param) && length(param)==nrow(mat) ) # reorder the dendrogram if necessary dh <- reorderfun(dh, param) # wrap up into a aheatmap_treedef object as_treedef(dh, dist.method=hc$dist.method, method=hc$method) } } #scale_rows = function(x){ # m = apply(x, 1, mean) # s = apply(x, 1, sd) # return((x - m) / s) #} scale_mat = function(x, scale, na.rm=TRUE){ av <- c("none", "row", "column", 'r1', 'c1') i <- pmatch(scale, av) if( is_NA(i) ) stop("scale argument shoud take values: 'none', 'row' or 'column'") scale <- av[i] switch(scale, none = x , row = { x <- sweep(x, 1L, rowMeans(x, na.rm = na.rm), check.margin = FALSE) sx <- apply(x, 1L, sd, na.rm = na.rm) sweep(x, 1L, sx, "/", check.margin = FALSE) } , column = { x <- sweep(x, 2L, colMeans(x, na.rm = na.rm), check.margin = FALSE) sx <- apply(x, 2L, sd, na.rm = na.rm) sweep(x, 2L, sx, "/", check.margin = FALSE) } , r1 = sweep(x, 1L, rowSums(x, na.rm = na.rm), '/', check.margin = FALSE) , c1 = sweep(x, 2L, colSums(x, na.rm = na.rm), '/', check.margin = FALSE) ) } .Rd.seed <- new.env() round.pretty <- function(x, min=2){ if( is.null(x) ) return(NULL) n <- 0 y <- round(sort(x), n) if( all(diff(y)==0) ) return( round(x, min) ) while( any(diff(y)==0) ){ n <- n+1 y <- round(sort(x), n) } dec <- max(min,n) round(x, dec) } generate_annotation_colours = function(annotation, annotation_colors, seed=TRUE){ if( is_NA(annotation_colors) ){ annotation_colors = list() } # use names from annotations if necessary/possible if( length(annotation_colors) > 0L && length(annotation_colors) <= length(annotation) && is.null(names(annotation_colors)) ){ names(annotation_colors) <- head(names(annotation), length(annotation_colors)) } count = 0 annotationLevels <- list() anames <- names(annotation) sapply(seq_along(annotation), function(i){ a <- annotation[[i]] if( class(annotation[[i]]) %in% c("character", "factor")){ # convert to character vector a <- if( is.factor(a) ) levels(a) else unique(a) count <<- count + nlevels(a) # merge if possible if( !is.null(anames) && anames[i]!='' ) annotationLevels[[anames[i]]] <<- unique(c(annotationLevels[[anames[i]]], a)) else annotationLevels <<- c(annotationLevels, list(a)) }else annotationLevels <<- c(annotationLevels, annotation[i]) }) annotation <- annotationLevels #str(annotationLevels) factor_colors = hcl(h = seq(1, 360, length.out = max(count+1,20)), 100, 70) # get random seeds to restore/update on exit rs <- RNGseed() on.exit({ # update local random seed on exit .Rd.seed$.Random.seed <- getRNG() # restore global random seed RNGseed(rs) }) # restore local random seed if it exists if( !is.null(.Rd.seed$.Random.seed) ) setRNG(.Rd.seed$.Random.seed) # set seed and restore on exit if( isTRUE(seed) ){ # reset .Random.seed to a dummy RNG in case the current kind is user-supplied: # we do not want to draw even once from the current RNG setRNG(c(401L, 0L, 0L)) set.seed(12345, 'default', 'default') } factor_colors <- sample(factor_colors) # pal(factor_colors); stop("sasa") res_colors <- list() for(i in 1:length(annotation)){ ann <- annotation[[i]] aname <- names(annotation)[i] # skip already generated colors acol_def <- res_colors[[aname]] if( !is.null(acol_def) ) next; acol <- annotation_colors[[aname]] if( is.null(acol) ){ res_colors[[aname]] <- if( class(annotation[[i]]) %in% c("character", "factor")){ lev <- ann ind = 1:length(lev) acol <- setNames(factor_colors[ind], lev) factor_colors = factor_colors[-ind] # conserve NA value acol[which(is.na(names(acol)))] <- NA acol } else{ h = round(runif(1) * 360) rg <- range(ann, na.rm=TRUE) if( rg[1] == rg[2] ) rg <- sort(c(0, rg[1])) setNames(rev(sequential_hcl(2, h, l = c(50, 95))), round.pretty(rg)) } }else{ acol <- if( length(acol) == 1 && grepl("^\\$", acol) ) # copy colors from other columns if the spec starts with '$' annotation_colors[[substr(acol, 2, nchar(acol))]] else if( !is.numeric(ann) ){ local({ #do this locally so that it does not affect `ann` # subset to the levels for which no colour has already been defined lev <- ann # subset to the levels for which no colour has already been defined # idx <- which(!lev %in% names(acol_def) & !is.na(lev)) # lev <- lev[idx] # #idx <- idx + length(acol_def) # # if( length(lev) == 0L ) acol_def # nothing to add # else { # convert to a palette of the number of levels if necessary nl <- length(lev) acol <- ccPalette(acol, nl) if( is.null(names(acol)) ) names(acol) <- lev c(acol_def, acol) } }) }else{ acol <- ccPalette(acol) if( is.null(names(acol)) ) names(acol) <- round.pretty(seq(min(ann, na.rm=TRUE), max(ann, na.rm=TRUE), length.out=length(acol))) acol } # update the colors if necessary if( !is.null(acol) ) res_colors[[aname]] <- acol } # store type information attr(res_colors[[aname]], 'afactor') <- !is.numeric(ann) } # return ordered colors as the annotations res_colors[names(annotation)[!duplicated(names(annotation))]] } # Create row/column names generate_dimnames <- function(x, n, ref){ if( is_NA(x) ) NULL else if( length(x) == n ) x else if( identical(x, 1) || identical(x, 1L) ) 1L:n else if( isString(x) ){ regexp <- "^/(.+)/([0-9]+)?$" if( grepl(regexp, x) ){ x <- str_match(x, regexp) p <- x[1,2] n <- if( x[1, 3] != '' ) as.numeric(x[1, 2]) else 2L s <- str_match(ref, p)[, n] ifelse(is.na(s), ref, s) } else paste(x, 1L:n, sep='') #print(str_match_all(x, "^/(([^%]*)(%[in])?)+/$")) } else stop("aheatmap - Invalid row/column label. Possible values are:" , " NA, a vector of correct length, value 1 (or 1L) or single character string.") } .make_annotation <- function(x, ord=NULL){ # convert into a data.frame if necessary if( !is.data.frame(x) ){ x <- if( is(x, 'ExpressionSet') ) Biobase::pData(x) else if( is.factor(x) || is.character(x) ) data.frame(Factor=x) else if( is.numeric(x) ) data.frame(Variable=x) else stop("aheatmap - Invalid annotation argument `", substitute(x), "`: must be a data.frame, a factor or a numeric vector") } # reorder if necessary if( !is.null(ord) ) x <- x[ord, , drop = F] # return modifed object x } renderAnnotations <- function(annCol, annRow, annotation_colors, verbose=getOption('verbose')){ # concatenate both col and row annotation annotation <- list() if( is_NA(annotation_colors) ) annotation_colors <- list() nc <- length(annCol) nr <- length(annRow) flag <- function(x, f){ if( missing(f) ) attr(x, 'flag') else{ attr(x, 'flag') <- f; x} } if( !is_NA(annCol) ) annotation <- c(annotation, sapply(as.list(annCol), flag, 'col', simplify=FALSE)) if( !is_NA(annRow) ) annotation <- c(annotation, sapply(as.list(annRow), flag, 'row', simplify=FALSE)) if( length(annotation) == 0 ) return( list(annCol=NA, annRow=NA, colors=NA) ) # generate the missing name n <- names(annotation) xnames <- paste('X', 1:length(annotation), sep='') if( is.null(n) ) names(annotation) <- xnames else names(annotation)[n==''] <- xnames[n==''] # preprocess the annotation color links if( !is.null(cnames <- names(annotation_colors)) ){ m <- str_match(cnames, "^@([^{]+)\\{([^}]+)\\}") apply(m, 1L, function(x){ # skip unmatched names if( is_NA(x[1]) ) return() acol <- annotation_colors[[x[1]]] # rename both annotation and annotation_colors if necessary if( x[2] != x[3] ){ annotation[[x[3]]] <<- annotation[[x[2]]] annotation[[x[2]]] <<- NULL if( !is_NA(acol) ) annotation_colors[[x[3]]] <<- acol annotation_colors[[x[1]]] <<- NULL } }) } # message("### ANNOTATION ###"); print(annotation) # message("### ANNOTATION COLORS ###"); print(annotation_colors) if( verbose ) message("Generate column annotation colours") annotation_colors <- generate_annotation_colours(annotation, annotation_colors) if( verbose > 2 ){ message("### Annotation colors ###") print(annotation_colors) message("#########################") } # bind each annotation with its respective color and regroup into column and row annotation res <- list() lapply(seq_along(annotation), function(i){ aname <- names(annotation)[i] acol <- annotation_colors[[aname]] if( is.null(acol) ) stop("aheatmap - No color was defined for annotation '", aname, "'.") attr(annotation[[i]], 'color') <- acol # put into the right annotation list if( flag(annotation[[i]]) == 'col' ) res$annCol <<- c(res$annCol, annotation[i]) else res$annRow <<- c(res$annRow, annotation[i]) }) res$annCol <- if( !is.null(res$annCol) ) convert_annotations(res$annCol, annotation_colors) else NA res$annRow <- if( !is.null(res$annRow) ) convert_annotations(res$annRow, annotation_colors) else NA res$colors <- annotation_colors # return result list res } # set/get special annotation handlers specialAnnotation <- local({ .empty <- list(list(), list()) .cache <- .empty function(margin, name, fun, clear=FALSE){ if( isTRUE(clear) ){ if( nargs() > 1L ) stop("Invalid call: no other argument can be passed when `clear=TRUE`") .cache <<- .empty return() } if( missing(name) && missing(fun) ){ return(.cache[[margin]]) }else if( is.list(name) ){ .cache[[margin]] <<- c(.cache[[margin]], name) }else if( missing(fun) ){ return(.cache[[margin]][[name]]) }else{ .cache[[margin]][[name]] <<- fun } } }) # Converts Subset Specification into Indexes subset_index <- function(x, margin, subset){ # if null then do nothing if( is.null(subset) ) return( NULL ) # get dimension n <- dim(x)[margin] dn <- dimnames(x)[[margin]] dt <- if( margin == 1L ) "rows" else "columns" so <- deparse(substitute(subset)) if( length(subset) == 0 ) stop("Invalid empty subset object `", so, "`") subIdx <- if( is.logical(subset) ){ if( length(subset) != n ){ if( n %% length(subset) == 0 ) subset <- rep(subset, n / length(subset)) else stop("Invalid length for logical subset argument `", so, "`: number of ", dt, " [" , n, "] is not a multiple of subset length [",length(subset),"].") } # convert into indexes which(subset) } else if( is.integer(subset) || is.character(subset) ){ if( length(subset) > n ) stop("Invalid too long integer/character subset argument `", so , "`: length must not exceed the number of ", dt, " [", n, "].") if( anyDuplicated(subset) ) warning("Duplicated index or name in subset argument `", so, "`.") # for character argument: match against dimname to convert into indexes if( is.character(subset) ){ if( is.null(dn) ) stop("Could not subset the ", dt, " with a character subset argument `", so, "`: no " , if( margin == 1L ) "rownames" else "colnames" , " are available.") msubset <- match(subset, dn) nas <- is.na(msubset) if( any(nas) ){ warning("Mismatch in character subset argument `", so ,"`: Could not find ", sum(nas), " out of ", length(subset), " names (" , paste("'", head(subset[nas], 5), "'", sep='', collapse=', ') , if( sum(nas) > 5 ) ", ... ", ").") msubset <- msubset[!nas] } subset <- msubset } subset }else stop("Invalid subset argument `", so, "`: should be a logical, integer or character vector.") # return the indexes sorted sort(subIdx) } #' Annotated Heatmaps #' #' The function \code{aheatmap} plots high-quality heatmaps, with a detailed legend #' and unlimited annotation tracks for both columns and rows. #' The annotations are coloured differently according to their type #' (factor or numeric covariate). #' Although it uses grid graphics, the generated plot is compatible with base #' layouts such as the ones defined with \code{'mfrow'} or \code{\link{layout}}, #' enabling the easy drawing of multiple heatmaps on a single a plot -- at last!. #' #' The development of this function started as a fork of the function #' \code{pheatmap} from the \pkg{pheatmap} package, and provides #' several enhancements such as: #' \itemize{ #' \item argument names match those used in the base function \code{\link{heatmap}}; #' \item unlimited number of annotation for \strong{both} columns and rows, #' with simplified and more flexible interface; #' \item easy specification of clustering methods and colors; #' \item return clustering data, as well as grid grob object. #' } #' #' Please read the associated vignette for more information and sample code. #' #' @section PDF graphic devices: if plotting on a PDF graphic device -- started with \code{\link{pdf}}, #' one may get generate a first blank page, due to internals of standard functions from #' the \pkg{grid} package that are called by \code{aheatmap}. #' The \pkg{NMF} package ships a custom patch that fixes this issue. #' However, in order to comply with CRAN policies, the patch is \strong{not} applied by default #' and the user must explicitly be enabled it. #' This can be achieved on runtime by either setting the NMF specific option 'grid.patch' #' via \code{nmf.options(grid.patch=TRUE)}, or on load time if the environment variable #' 'R_PACKAGE_NMF_GRID_PATCH' is defined and its value is something that is not equivalent #' to \code{FALSE} (i.e. not '', 'false' nor 0). #' #' @param x numeric matrix of the values to be plotted. #' An \code{\link[Biobase:ExpressionSet-class]{ExpressionSet}} objects can also #' be passed, in which case the expression values are plotted (\code{exprs(x)}). #' #' @param color colour specification for the heatmap. Default to palette #' '-RdYlBu2:100', i.e. reversed palette 'RdYlBu2' (a slight modification of #' RColorBrewer's palette 'RdYlBu') with 100 colors. #' Possible values are: #' \itemize{ #' \item a character/integer vector of length greater than 1 that is directly used #' and assumed to contain valid R color specifications. #' \item a single color/integer (between 0 and 8)/other numeric value #' that gives the dominant colors. Numeric values are converted into a pallete #' by \code{rev(sequential_hcl(2, h = x, l = c(50, 95)))}. Other values are #' concatenated with the grey colour '#F1F1F1'. #' \item one of RColorBrewer's palette name (see \code{\link[RColorBrewer]{display.brewer.all}}) #' , or one of 'RdYlBu2', 'rainbow', 'heat', 'topo', 'terrain', 'cm'. #' } #' When the coluor palette is specified with a single value, and is negative or #' preceded a minus ('-'), the reversed palette is used. #' The number of breaks can also be specified after a colon (':'). For example, #' the default colour palette is specified as '-RdYlBu2:100'. #' #' @param breaks a sequence of numbers that covers the range of values in \code{x} and is one #' element longer than color vector. Used for mapping values to colors. Useful, if needed #' to map certain values to certain colors. If value is NA then the #' breaks are calculated automatically. If \code{breaks} is a single value, #' then the colour palette is centered on this value. #' #' @param border_color color of cell borders on heatmap, use NA if no border should be #' drawn. #' #' @param cellwidth individual cell width in points. If left as NA, then the values #' depend on the size of plotting window. #' #' @param cellheight individual cell height in points. If left as NA, #' then the values depend on the size of plotting window. #' #' @param scale character indicating how the values should scaled in #' either the row direction or the column direction. Note that the scaling is #' performed after row/column clustering, so that it has no effect on the #' row/column ordering. #' Possible values are: #' \itemize{ #' \item \code{"row"}: center and standardize each row separately to row Z-scores #' \item \code{"column"}: center and standardize each column separately to column Z-scores #' \item \code{"r1"}: scale each row to sum up to one #' \item \code{"c1"}: scale each column to sum up to one #' \item \code{"none"}: no scaling #' } #' #' @param Rowv clustering specification(s) for the rows. It allows to specify #' the distance/clustering/ordering/display parameters to be used for the #' \emph{rows only}. #' Possible values are: #' \itemize{ #' \item \code{TRUE} or \code{NULL} (to be consistent with \code{\link{heatmap}}): #' compute a dendrogram from hierarchical clustering using the distance and #' clustering methods \code{distfun} and \code{hclustfun}. #' #' \item \code{NA}: disable any ordering. In this case, and if not otherwise #' specified with argument \code{revC=FALSE}, the heatmap shows the input matrix #' with the rows in their original order, with the first row on top to the last #' row at the bottom. Note that this differ from the behaviour or \code{\link{heatmap}}, #' but seemed to be a more sensible choice when vizualizing a matrix without #' reordering. #' #' \item an integer vector of length the number of rows of the input matrix #' (\code{nrow(x)}), that specifies the row order. As in the case \code{Rowv=NA}, #' the ordered matrix is shown first row on top, last row at the bottom. #' #' \item a character vector or a list specifying values to use instead of arguments #' \code{distfun}, \code{hclustfun} and \code{reorderfun} when clustering the #' rows (see the respective argument descriptions for a list of accepted #' values). #' If \code{Rowv} has no names, then the first element is used for \code{distfun}, #' the second (if present) is used for \code{hclustfun}, and the third #' (if present) is used for \code{reorderfun}. #' #' \item a numeric vector of weights, of length the number of rows of the input matrix, #' used to reorder the internally computed dendrogram \code{d} #' by \code{reorderfun(d, Rowv)}. #' #' \item \code{FALSE}: the dendrogram \emph{is} computed using methods \code{distfun}, #' \code{hclustfun}, and \code{reorderfun} but is not shown. #' #' \item a single integer that specifies how many subtrees (i.e. clusters) #' from the computed dendrogram should have their root faded out. #' This can be used to better highlight the different clusters. #' #' \item a single double that specifies how much space is used by the computed #' dendrogram. That is that this value is used in place of \code{treeheight}. #' } #' #' @param Colv clustering specification(s) for the columns. It accepts the same #' values as argument \code{Rowv} (modulo the expected length for vector specifications), #' and allow specifying the distance/clustering/ordering/display parameters to #' be used for the \emph{columns only}. #' \code{Colv} may also be set to \code{"Rowv"}, in which case the dendrogram #' or ordering specifications applied to the rows are also applied to the #' columns. Note that this is allowed only for square input matrices, #' and that the row ordering is in this case by default reversed #' (\code{revC=TRUE}) to obtain the diagonal in the standard way #' (from top-left to bottom-right). #' See argument \code{Rowv} for other possible values. #' #' @param revC a logical that specify if the \emph{row order} defined by #' \code{Rowv} should be reversed. This is mainly used to get the rows displayed #' from top to bottom, which is not the case by default. Its default value is #' computed at runtime, to suit common situations where natural ordering is a #' more sensible choice: no or fix ordering of the rows (\code{Rowv=NA} or an #' integer vector of indexes -- of length > 1), and when a symmetric ordering is #' requested -- so that the diagonal is shown as expected. #' An argument in favor of the "odd" default display (bottom to top) is that the #' row dendrogram is plotted from bottom to top, and reversing its reorder may #' take a not too long but non negligeable time. #' #' @param distfun default distance measure used in clustering rows and columns. #' Possible values are: #' \itemize{ #' \item all the distance methods supported by \code{\link{dist}} #' (e.g. "euclidean" or "maximum"). #' #' \item all correlation methods supported by \code{\link{cor}}, #' such as \code{"pearson"} or \code{"spearman"}. #' The pairwise distances between rows/columns are then computed as #' \code{d <- dist(1 - cor(..., method = distfun))}. #' #' One may as well use the string "correlation" which is an alias for "pearson". #' #' \item an object of class \code{dist} such as returned by \code{\link{dist}} or #' \code{\link{as.dist}}. #' } #' #' @param hclustfun default clustering method used to cluster rows and columns. #' Possible values are: #' \itemize{ #' \item a method name (a character string) supported by \code{\link{hclust}} #' (e.g. \code{'average'}). #' \item an object of class \code{hclust} such as returned by \code{\link{hclust}} #' \item a dendrogram #' } #' #' @param reorderfun default dendrogram reordering function, used to reorder the #' dendrogram, when either \code{Rowv} or \code{Colv} is a numeric weight vector, #' or provides or computes a dendrogram. It must take 2 parameters: a dendrogram, #' and a weight vector. #' #' @param subsetRow Specification of subsetting the rows before drawing the #' heatmap. #' Possible values are: #' \itemize{ #' \item an integer vector of length > 1 specifying the indexes of the rows to #' keep; #' \item a character vector of length > 1 specyfing the names of the rows to keep. #' These are the original rownames, not the names specified in \code{labRow}. #' \item a logical vector of length > 1, whose elements are recycled if the #' vector has not as many elements as rows in \code{x}. #' } #' Note that in the case \code{Rowv} is a dendrogram or hclust object, it is first #' converted into an ordering vector, and cannot be displayed -- and a warning is thrown. #' #' @param subsetCol Specification of subsetting the columns before drawing the #' heatmap. It accepts the similar values as \code{subsetRow}. See details above. #' #' @param txt character matrix of the same size as \code{x}, that contains text to #' display in each cell. #' \code{NA} values are allowed and are not displayed. #' See demo for an example. #' #' @param treeheight how much space (in points) should be used to display #' dendrograms. If specified as a single value, it is used for both dendrograms. #' A length-2 vector specifies separate values for the row and #' column dendrogram respectively. #' Default value: 50 points. #' #' @param legend boolean value that determines if a colour ramp for the heatmap's #' colour palette should be drawn or not. #' Default is \code{TRUE}. #' #' @param annCol specifications of column annotation tracks displayed as coloured #' rows on top of the heatmaps. The annotation tracks are drawn from bottom to top. #' A single annotation track can be specified as a single vector; multiple tracks #' are specified as a list, a data frame, or an #' \code{\link[Biobase:ExpressionSet-class]{ExpressionSet}} object, in #' which case the phenotypic data is used (\code{pData(eset)}). #' Character or integer vectors are converted and displayed as factors. #' Unnamed tracks are internally renamed into \code{Xi}, with i being incremented for #' each unamed track, across both column and row annotation tracks. #' For each track, if no corresponding colour is specified in argument #' \code{annColors}, a palette or a ramp is automatically computed and named #' after the track's name. #' #' @param annRow specifications of row annotation tracks displayed as coloured #' columns on the left of the heatmaps. The annotation tracks are drawn from #' left to right. The same conversion, renaming and colouring rules as for argument #' \code{annCol} apply. #' #' @param annColors list for specifying annotation track colors manually. It is #' possible to define the colors for only some of the annotations. Check examples for #' details. #' #' @param annLegend boolean value specifying if the legend for the annotation tracks #' should be drawn or not. #' Default is \code{TRUE}. #' #' @param labRow labels for the rows. #' @param labCol labels for the columns. See description for argument \code{labRow} #' for a list of the possible values. #' #' @param fontsize base fontsize for the plot #' @param cexRow fontsize for the rownames, specified as a fraction of argument #' \code{fontsize}. #' @param cexCol fontsize for the colnames, specified as a fraction of argument #' \code{fontsize}. #' #' @param main Main title as a character string or a grob. #' @param sub Subtitle as a character string or a grob. #' @param info (experimental) Extra information as a character vector or a grob. #' If \code{info=TRUE}, information about the clustering methods is displayed #' at the bottom of the plot. #' #' @param filename file path ending where to save the picture. Currently following #' formats are supported: png, pdf, tiff, bmp, jpeg. Even if the plot does not fit into #' the plotting window, the file size is calculated so that the plot would fit there, #' unless specified otherwise. #' @param width manual option for determining the output file width in #' @param height manual option for determining the output file height in inches. #' #' @param verbose if \code{TRUE} then verbose messages are displayed and the #' borders of some viewports are highlighted. It is entended for debugging #' purposes. #' #' @param gp graphical parameters for the text used in plot. Parameters passed to #' \code{\link{grid.text}}, see \code{\link{gpar}}. #' #' @author #' Original version of \code{pheatmap}: Raivo Kolde #' #' Enhancement into \code{aheatmap}: Renaud Gaujoux #' #' @examples #' #' ## See the demo 'aheatmap' for more examples: #' \dontrun{ #' demo('aheatmap') #' } #' #' # Generate random data #' n <- 50; p <- 20 #' x <- abs(rmatrix(n, p, rnorm, mean=4, sd=1)) #' x[1:10, seq(1, 10, 2)] <- x[1:10, seq(1, 10, 2)] + 3 #' x[11:20, seq(2, 10, 2)] <- x[11:20, seq(2, 10, 2)] + 2 #' rownames(x) <- paste("ROW", 1:n) #' colnames(x) <- paste("COL", 1:p) #' #' ## Default heatmap #' aheatmap(x) #' #' ## Distance methods #' aheatmap(x, Rowv = "correlation") #' aheatmap(x, Rowv = "man") # partially matched to 'manhattan' #' aheatmap(x, Rowv = "man", Colv="binary") #' #' # Generate column annotations #' annotation = data.frame(Var1 = factor(1:p %% 2 == 0, labels = c("Class1", "Class2")), Var2 = 1:10) #' aheatmap(x, annCol = annotation) #' #' @demo Annotated heatmaps #' #' # Generate random data #' n <- 50; p <- 20 #' x <- abs(rmatrix(n, p, rnorm, mean=4, sd=1)) #' x[1:10, seq(1, 10, 2)] <- x[1:10, seq(1, 10, 2)] + 3 #' x[11:20, seq(2, 10, 2)] <- x[11:20, seq(2, 10, 2)] + 2 #' rownames(x) <- paste("ROW", 1:n) #' colnames(x) <- paste("COL", 1:p) #' #' ## Scaling #' aheatmap(x, scale = "row") #' aheatmap(x, scale = "col") # partially matched to 'column' #' aheatmap(x, scale = "r1") # each row sum up to 1 #' aheatmap(x, scale = "c1") # each colum sum up to 1 #' #' ## Heatmap colors #' aheatmap(x, color = colorRampPalette(c("navy", "white", "firebrick3"))(50)) #' # color specification as an integer: use R basic colors #' aheatmap(x, color = 1L) #' # color specification as a negative integer: use reverse basic palette #' aheatmap(x, color = -1L) #' # color specification as a numeric: use HCL color #' aheatmap(x, color = 1) #' # do not cluster the rows #' aheatmap(x, Rowv = NA) #' # no heatmap legend #' aheatmap(x, legend = FALSE) #' # cell and font size #' aheatmap(x, cellwidth = 10, cellheight = 5) #' #' # directly write into a file #' aheatmap(x, cellwidth = 15, cellheight = 12, fontsize = 8, filename = "aheatmap.pdf") #' unlink('aheatmap.pdf') #' #' # Generate column annotations #' annotation = data.frame(Var1 = factor(1:p %% 2 == 0, labels = c("Class1", "Class2")), Var2 = 1:10) #' #' aheatmap(x, annCol = annotation) #' aheatmap(x, annCol = annotation, annLegend = FALSE) #' #' #' # Specify colors #' Var1 = c("navy", "darkgreen") #' names(Var1) = c("Class1", "Class2") #' Var2 = c("lightgreen", "navy") #' #' ann_colors = list(Var1 = Var1, Var2 = Var2) #' #' aheatmap(x, annCol = annotation, annColors = ann_colors) #' #' # Specifying clustering from distance matrix #' drows = dist(x, method = "minkowski") #' dcols = dist(t(x), method = "minkowski") #' aheatmap(x, Rowv = drows, Colv = dcols) #' #' # Display text in each cells #' t <- outer(as.character(outer(letters, letters, paste0)), letters, paste0)[1:n, 1:p] #' aheatmap(x, txt = t) #' # NA values are shown as empty cells #' t.na <- t #' t.na[sample(length(t.na), 500)] <- NA # half of the cells #' aheatmap(x, txt = t.na) #' #' @export aheatmap = function(x , color = '-RdYlBu2:100' , breaks = NA, border_color=NA, cellwidth = NA, cellheight = NA, scale = "none" , Rowv=TRUE, Colv=TRUE , revC = identical(Colv, "Rowv") || is_NA(Rowv) || (is.integer(Rowv) && length(Rowv) > 1) || is(Rowv, 'silhouette') , distfun = "euclidean", hclustfun = "complete", reorderfun = function(d,w) reorder(d,w) , treeheight = 50 , legend = TRUE, annCol = NA, annRow = NA, annColors = NA, annLegend = TRUE , labRow = NULL, labCol = NULL , subsetRow = NULL, subsetCol = NULL , txt = NULL , fontsize=10, cexRow = min(0.2 + 1/log10(nr), 1.2), cexCol = min(0.2 + 1/log10(nc), 1.2) , filename = NA, width = NA, height = NA , main = NULL, sub = NULL, info = NULL , verbose=getOption('verbose'), gp = gpar()){ # set verbosity level ol <- lverbose(verbose) on.exit( lverbose(ol) ) # convert ExpressionSet into if( is(x, 'ExpressionSet') ){ requireNamespace('Biobase') #library(Biobase) if( isTRUE(annCol) ) annCol <- atrack(x) x <- Biobase::exprs(x) } # rename to old parameter name mat <- x if( !is.null(txt) ){ if( !all(dim(mat), dim(x)) ){ stop("Incompatible data and text dimensions: arguments x and txt must have the same size.") } } # init result list res <- list() # treeheight: use common or separate spec for rows and columns if( length(treeheight) == 1 ) treeheight <- c(treeheight, treeheight) treeheight_row <- treeheight[1] treeheight_col <- treeheight[2] ## SUBSET: process subset argument for rows/columsn if requested. # this has to be done before relabelling and clustering # but the actual subsetting has to be done after relabelling and before # clustering. # Here one convert a subset argument into an interger vector with the indexes if( !is.null(subsetRow) ){ if( verbose ) message("Compute row subset indexes") subsetRow <- subset_index(mat, 1L, subsetRow) } if( !is.null(subsetCol) ){ if( verbose ) message("Compute column subset indexes") subsetCol <- subset_index(mat, 2L, subsetCol) } ## LABELS: set the row/column labels # label row numerically if no rownames if( is.null(labRow) && is.null(rownames(mat)) ) labRow <- 1L if( !is.null(labRow) ){ if( verbose ) message("Process labRow") rownames(mat) <- generate_dimnames(labRow, nrow(mat), rownames(mat)) } # label columns numerically if no colnames if( is.null(labCol) && is.null(colnames(mat)) ) labCol <- 1L if( !is.null(labCol) ){ if( verbose ) message("Process labCol") colnames(mat) <- generate_dimnames(labCol, ncol(mat), colnames(mat)) } ## DO SUBSET if( !is.null(subsetRow) ){ mat <- mat[subsetRow, ] } if( !is.null(subsetCol) ){ mat <- mat[, subsetCol] } ## CLUSTERING # Do row clustering tree_row <- if( !is_NA(Rowv) ){ if( verbose ) message("Cluster rows") # single numeric Rowv means treeheight if( isReal(Rowv) ){ # treeheight treeheight_row <- Rowv # do cluster the rows Rowv <- TRUE } cluster_mat(mat, Rowv , distfun=distfun, hclustfun=hclustfun , reorderfun=reorderfun, subset=subsetRow , verbose = verbose) } else NA # do not show the tree if Rowv=FALSE or not a tree if( identical(Rowv, FALSE) || !is_treedef(tree_row) ) treeheight_row <- 0 # Do col clustering tree_col <- if( !is_NA(Colv) ){ if( identical(Colv,"Rowv") ){ # use row indexing if requested if( ncol(mat) != nrow(mat) ) stop("aheatmap - Colv='Rowv' but cannot treat columns and rows symmetrically: input matrix is not square.") treeheight_col <- treeheight_row tree_row }else{ # single numeric Colv means treeheight if( isReal(Colv) ){ # tree height treeheight_col <- Colv # do cluster the columns Colv <- TRUE } if( verbose ) message("Cluster columns") cluster_mat(t(mat), Colv , distfun=distfun, hclustfun=hclustfun , reorderfun=reorderfun, subset=subsetCol , verbose = verbose) } } else NA # do not show the tree if Colv=FALSE if( identical(Colv, FALSE) || !is_treedef(tree_col) ) treeheight_col <- 0 ## ORDER THE DATA if( !is_NA(tree_row) ){ # revert the row order if requested if( revC ){ if( verbose ) message("Reverse row clustering") tree_row <- rev(tree_row) } # store the order and row tree if possible if( is_treedef(tree_row) ){ res$Rowv <- tree_row$dendrogram res$rowInd <- order.dendrogram(tree_row$dendrogram) if( length(res$rowInd) != nrow(mat) ) stop("aheatmap - row dendrogram ordering gave index of wrong length (", length(res$rowInd), ")") } else{ res$rowInd <- tree_row tree_row <- NA } }else if( revC ){ # revert the row order if requested res$rowInd <- nrow(mat):1L } # possibly map the index to the original data index res$rowInd <- subset2orginal_idx(res$rowInd, subsetRow) # order the rows if necessary if( !is.null(res$rowInd) ){ # check validity of ordering if( !is.integer(res$rowInd) || length(res$rowInd) != nrow(mat) ) stop("aheatmap - Invalid row ordering: should be an integer vector of length nrow(mat)=", nrow(mat)) if( verbose ) message("Order rows") subInd <- attr(res$rowInd, 'subset') ri <- if( is.null(subInd) ) res$rowInd else subInd mat <- mat[ri, , drop=FALSE] # data if( !is.null(txt) ) txt <- txt[ri, , drop = FALSE] # text } if( !is_NA(tree_col) ){ # store the column order and tree if possible if( is_treedef(tree_col) ){ res$Colv <- tree_col$dendrogram res$colInd <- order.dendrogram(tree_col$dendrogram) if( length(res$colInd) != ncol(mat) ) stop("aheatmap - column dendrogram ordering gave index of wrong length (", length(res$colInd), ")") }else{ res$colInd <- tree_col tree_col <- NA } } # possibly map the index to the original data index res$colInd <- subset2orginal_idx(res$colInd, subsetCol) # order the columns if necessary if( !is.null(res$colInd) ){ # check validity of ordering if( !is.integer(res$colInd) || length(res$colInd) != ncol(mat) ) stop("aheatmap - Invalid column ordering: should be an integer vector of length ncol(mat)=", ncol(mat)) if( verbose ) message("Order columns") subInd <- attr(res$colInd, 'subset') ci <- if( is.null(subInd) ) res$colInd else subInd mat <- mat[, ci, drop=FALSE] # data if( !is.null(txt) ) txt <- txt[, ci, drop = FALSE] # text } # adding clustering info if( isTRUE(info) || is.character(info) ){ if( verbose ) message("Compute info") if( !is.character(info) ) info <- NULL linfo <- NULL if( is_treedef(tree_row) && !is.null(tree_row$dist.method) ) linfo <- paste("rows:", tree_row$dist.method, '/', tree_row$method) if( is_treedef(tree_col) && !is.null(tree_col$dist.method) ) linfo <- paste(linfo, paste(" - cols:", tree_col$dist.method, '/', tree_col$method)) info <- c(info, linfo) } # drop extra info except dendrograms for trees if( is_treedef(tree_col) ) tree_col <- tree_col$dendrogram if( is_treedef(tree_row) ) tree_row <- tree_row$dendrogram # Preprocess matrix if( verbose ) message("Scale matrix") mat = as.matrix(mat) mat = scale_mat(mat, scale) ## Colors and scales # load named palette if necessary color <- ccRamp(color) # generate breaks if necessary if( is_NA(breaks) || isNumber(breaks) ){ if( verbose ) message("Generate breaks") # if a single number: center the breaks on this value cbreaks <- if( isNumber(breaks) ) breaks else NA breaks = generate_breaks(as.vector(mat), length(color), center=cbreaks) } if( isTRUE(legend) ){ if( verbose ) message("Generate data legend breaks") legend = grid.pretty(range(as.vector(breaks))) } else { legend = NA } mat = scale_colours(mat, col = color, breaks = breaks) annotation_legend <- annLegend annotation_colors <- annColors # render annotation tracks for both rows and columns annCol_processed <- atrack(annCol, order=res$colInd, .SPECIAL=specialAnnotation(2L), .DATA=amargin(x,2L), .CACHE=annRow) annRow_processed <- atrack(annRow, order=res$rowInd, .SPECIAL=specialAnnotation(1L), .DATA=amargin(x,1L), .CACHE=annCol) specialAnnotation(clear=TRUE) annTracks <- renderAnnotations(annCol_processed, annRow_processed , annotation_colors = annotation_colors , verbose=verbose) # # retrieve dimension for computing cexRow and cexCol (evaluated from the arguments) nr <- nrow(mat); nc <- ncol(mat) # Draw heatmap res$vp <- heatmap_motor(mat, border_color = border_color, cellwidth = cellwidth, cellheight = cellheight , treeheight_col = treeheight_col, treeheight_row = treeheight_row, tree_col = tree_col, tree_row = tree_row , filename = filename, width = width, height = height, breaks = breaks, color = color, legend = legend , annTracks = annTracks, annotation_legend = annotation_legend , txt = txt , fontsize = fontsize, fontsize_row = cexRow * fontsize, fontsize_col = cexCol * fontsize , main = main, sub = sub, info = info , verbose = verbose , gp = gp) # return info about the plot invisible(res) } #' @import gridBase grid.base.mix <- function(opar, trace = getOption('verbose')){ if( !missing(opar) ){ if( !is.null(opar) ){ if( trace ) message("grid.base.mix - restore") upViewport(2) par(opar) } return(invisible()) } if( trace ) message("grid.base.mix - init") if( trace ) grid.rect(gp=gpar(lwd=40, col="blue")) opar <- par(xpd=NA) if( trace ) grid.rect(gp=gpar(lwd=30, col="green")) if( trace ) message("grid.base.mix - plot.new") plot.new() if( trace ) grid.rect(gp=gpar(lwd=20, col="black")) vps <- baseViewports() pushViewport(vps$inner) if( trace ) grid.rect(gp=gpar(lwd=10, col="red")) pushViewport(vps$figure) # if( trace ) grid.rect(gp=gpar(lwd=3, col="green")) # pushViewport(vps$plot) # upViewport(2) # if( trace ) grid.rect(gp=gpar(lwd=3, col="pink")) # pushViewport(viewport(x=unit(0.5, "npc"), y=unit(0, "npc"), width=unit(0.5, "npc"), height=unit(1, "npc"), just=c("left","bottom"))) if( trace ) grid.rect(gp=gpar(lwd=3, col="yellow")) opar } if( FALSE ){ testmix <- function(){ opar <- mixplot.start(FALSE) profplot(curated$data$model, curated$fits[[1]]) mixplot.add(TRUE) basismarker(curated$fits[[1]], curated$data$markers) mixplot.end() par(opar) } dd <- function(d, horizontal = TRUE, ...){ grid.rect(gp = gpar(col = "blue", lwd = 2)) opar <- par(plt = gridPLT(), new = TRUE) on.exit(par(opar)) plot(d, horiz=horizontal, xaxs="i", yaxs="i", axes=FALSE, leaflab="none", ...) } toto <- function(new=FALSE){ library(RGraphics) set.seed(123456) x <- matrix(runif(30*20), 30) x <- crossprod(x) d <- as.dendrogram(hclust(dist(x))) #grid.newpage() if( new ) plot.new() lo <- grid.layout(nrow=2, ncol=2) pushViewport(viewport(layout=lo)) pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 1)) dd(d) upViewport() pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 2)) dd(d, FALSE) upViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 2)) grid.imageGrob(nrow(x), ncol(x), x) upViewport() popViewport() stop("END toto") } test <- function(){ pdf('aheatmap.pdf') #try(v <- aheatmap(consensus(res), color='grey:100', Colv=2L, verbose=TRUE)) try(v <- consensusmap(res, color='grey:100', Colv=2L, verbose=TRUE)) dev.off() } test2 <- function(){ op <- par(mfrow=c(1,2)) on.exit(par(op)) #try(v <- aheatmap(consensus(res), color='grey:100', Colv=2L, verbose=TRUE)) try(v <- consensusmap(res, verbose=TRUE)) try(v <- consensusmap(res, color='grey:100', Colv=2L, verbose=TRUE)) } testsw <- function(file=TRUE){ if(file ){ pdf('asweave.pdf', width=20, height=7) on.exit(dev.off()) } opar <- par(mfrow=c(1,2)) # removing all automatic annotation tracks coefmap(res, tracks=NA, verbose=TRUE) # customized plot coefmap(res, Colv = 'euclidean', Rowv='max', verbose=TRUE) # , main = "Metagene contributions in each sample", labCol = NULL # , tracks = c(Metagene='basis'), annCol = list(Class=a, Index=c) # , annColors = list(Metagene='Set2') # , info = TRUE) par(opar) } testvp <- function(file=TRUE){ if(file ){ pdf('avp.pdf', width=20, height=7) on.exit(dev.off()) } plot.new() lo <- grid.layout(nrow=1, ncol=2) pushViewport(viewport(layout=lo)) pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 1)) basismap(res, Colv='eucl', verbose=TRUE) upViewport() pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 2)) coefmap(res, tracks=NA, verbose=TRUE) upViewport() popViewport() } } NMF/R/NMFStrategyIterative-class.R0000644000176000001440000010574312305630424016402 0ustar ripleyusers#' @include NMFStrategy-class.R #' @include NMFfit-class.R NULL # Define union class for generalised function slots, e.g., slot 'NMFStrategyIterative::Stop' setClassUnion('.GfunctionSlotNULL', c('character', 'integer', 'numeric', 'function', 'NULL')) #' Interface for Algorithms: Implementation for Iterative NMF Algorithms #' #' @description #' This class provides a specific implementation for the generic function \code{run} #' -- concretising the virtual interface class \code{\linkS4class{NMFStrategy}}, #' for NMF algorithms that conform to the following iterative schema (starred numbers #' indicate mandatory steps): #' #' \itemize{ #' \item 1. Initialisation #' \item 2*. Update the model at each iteration #' \item 3. Stop if some criterion is satisfied #' \item 4. Wrap up #' } #' #' This schema could possibly apply to all NMF algorithms, since these are essentially optimisation algorithms, #' almost all of which use iterative methods to approximate a solution of the optimisation problem. #' The main advantage is that it allows to implement updates and stopping criterion separately, and combine them #' in different ways. #' In particular, many NMF algorithms are based on multiplicative updates, following the approach from #' \cite{Lee2001}, which are specially suitable to be cast into this simple schema. #' #' @slot onInit optional function that performs some initialisation or pre-processing on #' the model, before starting the iteration loop. #' @slot Update mandatory function that implement the update step, which computes new values for the model, based on its #' previous value. #' It is called at each iteration, until the stopping criterion is met or the maximum number of iteration is #' achieved. #' @slot Stop optional function that implements the stopping criterion. #' It is called \strong{before} each Update step. #' If not provided, the iterations are stopped after a fixed number of updates. #' @slot onReturn optional function that wraps up the result into an NMF object. #' It is called just before returning the #' setClass('NMFStrategyIterative' , representation( onInit = '.functionSlotNULL', Update = '.functionSlot', # update method Stop = '.GfunctionSlotNULL', # method called just after the update onReturn = '.functionSlotNULL' # method called just before returning the resulting NMF object ) , prototype=prototype( onInit = NULL , Update = '' , Stop = NULL , onReturn = NULL ) , contains = 'NMFStrategy' , validity = function(object){ if( is.character(object@Update) && object@Update == '' ) return("Slot 'Update' is required") # check the arguments of methods 'Update' and 'Stop' # (except for the 3 mandatory ones) n.update <- names(formals(object@Update)) # at least 3 arguments for 'Update' if( length(n.update) < 3 ){ return(str_c("Invalid 'Update' method - must have at least 3 arguments: ", "current iteration number [i], ", "target matrix [y], ", "current NMF model iterate [x]")) } n.update <- n.update[-seq(3)] # argument '...' must be present in method 'Update' if( !is.element('...', n.update) ) return("Invalid 'Update' method: must have argument '...' (even if not used)") # at least 3 arguments for 'Stop' if( !is.null(object@Stop) ){ # retrieve the stopping criterion and check its intrinsic validity .stop <- tryCatch( NMFStop(object@Stop, check=TRUE), error = function(e) return(message(e))) # Update and Stop methods cannot have overlapping arguments n.stop <- names(formals(.stop)) overlap <- intersect(n.update, n.stop) overlap <- overlap[which(overlap!='...')] if( length(overlap) > 0 ){ return(str_c("Invalid 'Update' and 'Stop' methods: conflicting arguments ", str_out(overlap, Inf))) } } TRUE } ) #' Show method for objects of class \code{NMFStrategyIterative} #' @export setMethod('show', 'NMFStrategyIterative', function(object){ #cat('') callNextMethod() cat(" \n") # go through the slots s.list <- names(getSlots('NMFStrategyIterative')) s.list <- setdiff(s.list, names(getSlots('NMFStrategy'))) #s.list <- s.list[s.list=='ANY'] # s.list <- c('Update', 'Stop', 'WrapNMF') out <- sapply(s.list, function(sname){ svalue <- slot(object,sname) svalue <- if( is.function(svalue) ) { str_args(svalue, exdent=12) } else if( is.null(svalue) ){ 'none' } else { paste("'", svalue,"'", sep='') } str_c(sname, ": ", svalue) }) cat(str_c(' ', out, collapse='\n'), "\n", sep='') return(invisible()) } ) ###% This class is an auxiliary class that defines the strategy's methods by directly callable functions. setClass('NMFStrategyIterativeX' , contains = 'NMFStrategyIterative' , representation = representation( workspace = 'environment' # workspace to use persistent variables accross methods ) ) ###% Creates a NMFStrategyIterativeX object from a NMFStrategyIterative object. xifyStrategy <- function(strategy, workspace=new.env(emptyenv())){ # do nothing if already executable if( is(strategy, 'NMFStrategyIterativeX') ) return(strategy) # first check the strategy's validity if( is.character(err <- validObject(strategy, test=TRUE)) ){ stop("Invalid strategy definition:\n\t- ", err) } # intanciate the NMFStrategyIterativeX, creating the strategy's workspace strategyX <- new('NMFStrategyIterativeX', strategy, workspace=workspace) # define auxiliary function to preload the 'function' slots in class NMFStrategyIterativeX preload.slot <- function(strategy, sname, default){ # get the content of the slot svalue <- slot(strategy,sname) # if the slot is valid (i.e. it's a non-empty character string), then process the name into a valid function fun <- if( is.null(svalue) && !missing(default) ) default else if( sname == 'Stop' ) NMFStop(svalue) else if( is.character(svalue) && nchar(svalue) > 0 ){ # set the slot with the executable version of the function getFunction(svalue) }else if( is.function(svalue) ) svalue else stop("NMFStrategyIterativeX - could not pre-load slot '", sname, "'") # return the loaded function fun } # preload the function slots slot(strategyX, 'Update') <- preload.slot(strategyX, 'Update') slot(strategyX, 'Stop') <- preload.slot(strategyX, 'Stop', function(strategy, i, target, data, ...){FALSE}) slot(strategyX, 'onReturn') <- preload.slot(strategyX, 'onReturn', identity) # load the objective function objective(strategyX) <- nmfDistance(objective(strategy)) # valid the preloaded object validObject(strategyX) # return the executable strategy strategyX } # #setGeneric('Update', function(object, v, ...) standardGeneric('Update') ) #setMethod('Update', signature(object='NMFStrategyIterative', v='matrix'), function(object, v, ...){ object@data <- object@Update(v, object@data, ...) }) # #setGeneric('Stop', function(object, i) standardGeneric('Stop') ) #setMethod('Stop', signature(object='NMFStrategyIterative', i='integer'), function(object, i){ object@Stop(i, object@data) }) # #setGeneric('WrapNMF', function(object) standardGeneric('WrapNMF') ) #setMethod('WrapNMF', signature(object='NMFStrategyIterative'), function(object){ object@WrapNMF(object@data) }) ###% Hook to initialize built-in iterative methods when the package is loaded ###% Hook to initialize old R version built-in iterative methods #' Get/Set a Static Variable in NMF Algorithms #' #' @description #' This function is used in iterative NMF algorithms to manage variables #' stored in a local workspace, that are accessible to all functions that #' define the iterative schema described in \code{\linkS4class{NMFStrategyIterative}}. #' #' It is specially useful for computing stopping criteria, which often require model data from #' different iterations. #' #' @param name Name of the static variable (as a single character string) #' @param value New value of the static variable #' @param init a logical used when a \code{value} is provided, that specifies #' if the variable should be set to the new value only if it does not exist yet #' (\code{init=TRUE}). #' @return The value of the static variable #' @export staticVar <- local({ .Workspace <- NULL function(name, value, init=FALSE){ # return last workspace if( missing(name) ) return(.Workspace) else if( is.null(name) ){ # reset workspace .Workspace <<- NULL return() } else if( is.environment(name) ){ # setup up static environment nmf.debug('Strategy Workspace', "initialize static workspace: ", capture.output(.Workspace), "=", capture.output(name)) .Workspace <<- name }else if( isString(name) && is.environment(.Workspace) ){ if( missing(value) ){ get(name, envir=.Workspace, inherits=FALSE) }else{ if( !init || !exists(name, envir=.Workspace, inherits=FALSE) ) { if( init ) nmf.debug('Strategy Workspace', "initialize variable '", name, "'") assign(name, value, envir=.Workspace) } # return current value get(name, envir=.Workspace, inherits=FALSE) } }else{ stop("Invalid NMF workspace query: .Workspace=", class(.Workspace), '| name=', name , if( !missing(value) ) paste0(' | value=', class(value))) } } }) #' Runs an NMF iterative algorithm on a target matrix \code{y}. #' #' @param .stop specification of a stopping criterion, that is used instead of the #' one associated to the NMF algorithm. #' It may be specified as: #' \itemize{ #' \item the access key of a registered stopping criterion; #' \item a single integer that specifies the exact number of iterations to perform, which will #' be honoured unless a lower value is explicitly passed in argument \code{maxIter}. #' \item a single numeric value that specifies the stationnarity threshold for the #' objective function, used in with \code{\link{nmf.stop.stationary}}; #' \item a function with signature \code{(object="NMFStrategy", i="integer", y="matrix", x="NMF", ...)}, #' where \code{object} is the \code{NMFStrategy} object that describes the algorithm being run, #' \code{i} is the current iteration, \code{y} is the target matrix and \code{x} is the current value of #' the NMF model. #' } #' @param maxIter maximum number of iterations to perform. #' #' @rdname NMFStrategy setMethod('run', signature(object='NMFStrategyIterative', y='matrix', x='NMFfit'), function(object, y, x, .stop=NULL, maxIter = nmf.getOption('maxIter') %||% 2000L, ...){ method <- object # override the stop method on runtime if( !is.null(.stop) ){ method@Stop <- NMFStop(.stop) # honour maxIter unless .stop is an integer and maxIter is not passed # either directly or from initial call # NB: maxIter may be not missing in the call to run() due to the application # of default arguments from the Strategy within nmf(), in which case one does not # want to honour it, since it is effectively missing in the original call. if( is.integer(.stop) && (missing(maxIter) || !('maxIter' %in% names(x@call))) ) maxIter <- .stop[1] } # debug object in debug mode if( nmf.getOption('debug') ) show(method) #Vc# Define local workspace for static variables # this function can be called in the methods to get/set/initialize # variables that are persistent within the strategy's workspace .Workspace <- new.env() staticVar(.Workspace) on.exit( staticVar(NULL) ) # runtime resolution of the strategy's functions by their names if necessary strategyX = xifyStrategy(method, .Workspace) run(strategyX, y, x, maxIter=maxIter, ...) }) #' @rdname NMFStrategy setMethod('run', signature(object='NMFStrategyIterativeX', y='matrix', x='NMFfit'), function(object, y, x, maxIter, ...){ strategy <- object v <- y seed <- x #V!# NMFStrategyIterativeX::run #Vc# Define workspace accessor function # this function can be called in the methods to get/set/initialize # variables that are persistent within the strategy's workspace # .Workspace <- strategy@workspace # assign('staticVar', function(name, value, init=FALSE){ # if( missing(value) ){ # get(name, envir=.Workspace, inherits=FALSE) # }else{ # if( !init || !exists(name, envir=.Workspace, inherits=FALSE) ) # { # if( init ) nmf.debug('Strategy Workspace', "initialize variable '", name, "'") # assign(name, value, envir=.Workspace) # } # } # } # , envir=.Workspace) #Vc# initialize the strategy # check validity of arguments if possible method.args <- nmfFormals(strategy, runtime=TRUE) internal.args <- method.args$internals expected.args <- method.args$defaults passed.args <- names(list(...)) forbidden.args <- is.element(passed.args, c(internal.args)) if( any(forbidden.args) ){ stop("NMF::run - Update/Stop method : formal argument(s) " , paste( paste("'", passed.args[forbidden.args],"'", sep=''), collapse=', ') , " already set internally.", call.=FALSE) } # !is.element('...', expected.args) && if( any(t <- !pmatch(passed.args, names(expected.args), nomatch=FALSE)) ){ stop("NMF::run - onInit/Update/Stop method for algorithm '", name(strategy),"': unused argument(s) " , paste( paste("'", passed.args[t],"'", sep=''), collapse=', '), call.=FALSE) } # check for required arguments required.args <- sapply(expected.args, function(x){ x <- as.character(x); length(x) == 1 && nchar(x) == 0 } ) required.args <- names(expected.args[required.args]) required.args <- required.args[required.args!='...'] if( any(t <- !pmatch(required.args, passed.args, nomatch=FALSE)) ) stop("NMF::run - Update/Stop method for algorithm '", name(strategy),"': missing required argument(s) " , paste( paste("'", required.args[t],"'", sep=''), collapse=', '), call.=FALSE) #Vc# Start iterations nmfData <- seed # cache verbose level verbose <- verbose(nmfData) # clone the object to allow the updates to work in place if( verbose > 1L ) message("# Cloning NMF model seed ... ", appendLF=FALSE) nmfFit <- clone(fit(nmfData)) if( verbose > 1L ) message("[", C.ptr(fit(nmfData)), " -> ", C.ptr(nmfFit), "]") ## onInit if( is.function(strategy@onInit) ){ if( verbose > 1L ) message("# Step 1 - onInit ... ", appendLF=TRUE) nmfFit <- strategy@onInit(strategy, v, nmfFit, ...) if( verbose > 1L ) message("OK") } ## # pre-load slots updateFun <- strategy@Update stopFun <- strategy@Stop showNIter.step <- 50L showNIter <- verbose && maxIter >= showNIter.step if( showNIter ){ ndIter <- nchar(as.character(maxIter)) itMsg <- paste0('Iterations: %', ndIter, 'i', "/", maxIter) cat(itMsgBck <- sprintf(itMsg, 0)) itMsgBck <- nchar(itMsgBck) } i <- 0L while( TRUE ){ #Vc# Stopping criteria # check convergence (generally do not stop for i=0L, but only initialise static variables stop.signal <- stopFun(strategy, i, v, nmfFit, ...) # if the strategy ask for stopping, then stop the iteration if( stop.signal || i >= maxIter ) break; # increment i i <- i+1L if( showNIter && (i==1L || i %% showNIter.step == 0L) ){ cat(paste0(rep("\r", itMsgBck), sprintf(itMsg, i))) } #Vc# update the matrices nmfFit <- updateFun(i, v, nmfFit, ...) # every now and then track the error if required nmfData <- trackError(nmfData, deviance(strategy, nmfFit, v, ...), niter=i) } if( showNIter ){ ended <- if( stop.signal ) 'converged' else 'stopped' cat("\nDONE (", ended, " at ",i,'/', maxIter," iterations)\n", sep='') } # force to compute last error if not already done nmfData <- trackError(nmfData, deviance(strategy, nmfFit, v, ...), niter=i, force=TRUE) # store the fitted model fit(nmfData) <- nmfFit #Vc# wrap up # let the strategy build the result nmfData <- strategy@onReturn(nmfData) if( !inherits(nmfData, 'NMFfit') ){ stop('NMFStrategyIterative[', name(strategy), ']::onReturn did not return a "NMF" instance [returned: "', class(nmfData), '"]') } # set the number of iterations performed niter(nmfData) <- i #return the result nmf.debug('NMFStrategyIterativeX::run', 'Done') invisible(nmfData) }) #' @S3method nmfFormals NMFStrategyIterative nmfFormals.NMFStrategyIterative <- function(x, runtime=FALSE, ...){ strategy <- xifyStrategy(x) # from run method m <- getMethod('run', signature(object='NMFStrategyIterative', y='matrix', x='NMFfit')) run.args <- allFormals(m)[-(1:3)] # onInit init.args <- if( is.function(strategy@onInit) ) formals(strategy@onInit) # Update update.args <- formals(strategy@Update) # Stop stop.args <- formals(strategy@Stop) # spplit internals and internal.args <- names(c(init.args[1:3], update.args[1:3], stop.args[1:4])) expected.args <- c(init.args[-(1:3)], update.args[-(1:3)], stop.args[-(1:4)]) if( runtime ){ # prepend registered default arguments expected.args <- expand_list(strategy@defaults, expected.args) list(internal=internal.args, defaults=expected.args) }else{ args <- c(run.args, expected.args) # prepend registered default arguments expand_list(strategy@defaults, args) } } ################################################################################################ # INITIALIZATION METHODS ################################################################################################ ################################################################################################ # UPDATE METHODS ################################################################################################ #' NMF Multiplicative Updates for Kullback-Leibler Divergence #' #' Multiplicative updates from \cite{Lee2001} for standard Nonnegative Matrix Factorization #' models \eqn{V \approx W H}, where the distance between the target matrix and its NMF #' estimate is measured by the Kullback-Leibler divergence. #' #' \code{nmf_update.KL.w} and \code{nmf_update.KL.h} compute the updated basis and coefficient #' matrices respectively. #' They use a \emph{C++} implementation which is optimised for speed and memory usage. #' #' @details #' The coefficient matrix (\code{H}) is updated as follows: #' \deqn{ #' H_{kj} \leftarrow H_{kj} \frac{\left( sum_i \frac{W_{ik} V_{ij}}{(WH)_{ij}} \right)}{ sum_i W_{ik} }. #' }{ #' H_kj <- H_kj ( sum_i [ W_ik V_ij / (WH)_ij ] ) / ( sum_i W_ik ) #' } #' #' These updates are used in built-in NMF algorithms \code{\link[=KL-nmf]{KL}} and #' \code{\link[=brunet-nmf]{brunet}}. #' #' @param v target matrix #' @param w current basis matrix #' @param h current coefficient matrix #' @param nbterms number of fixed basis terms #' @param ncterms number of fixed coefficient terms #' @param copy logical that indicates if the update should be made on the original #' matrix directly (\code{FALSE}) or on a copy (\code{TRUE} - default). #' With \code{copy=FALSE} the memory footprint is very small, and some speed-up may be #' achieved in the case of big matrices. #' However, greater care should be taken due the side effect. #' We recommend that only experienced users use \code{copy=TRUE}. #' #' @return a matrix of the same dimension as the input matrix to update #' (i.e. \code{w} or \code{h}). #' If \code{copy=FALSE}, the returned matrix uses the same memory as the input object. #' #' @author #' Update definitions by \cite{Lee2001}. #' #' C++ optimised implementation by Renaud Gaujoux. #' #' @rdname nmf_update_KL #' @aliases nmf_update.KL #' @export nmf_update.KL.h <- std.divergence.update.h <- function(v, w, h, nbterms=0L, ncterms=0L, copy=TRUE) { .Call("divergence_update_H", v, w, h, nbterms, ncterms, copy, PACKAGE='NMF') } #' \code{nmf_update.KL.w_R} and \code{nmf_update.KL.h_R} implement the same updates #' in \emph{plain R}. #' #' @param wh already computed NMF estimate used to compute the denominator term. #' #' @rdname nmf_update_KL #' @export nmf_update.KL.h_R <- R_std.divergence.update.h <- function(v, w, h, wh=NULL) { # compute WH if necessary if( is.null(wh) ) wh <- w %*% h # divergence-reducing NMF iterations # H_au = H_au ( sum_i [ W_ia V_iu / (WH)_iu ] ) / ( sum_k W_ka ) -> each row of H is divided by a the corresponding colSum of W h * crossprod(w, v / wh) / colSums(w) } #' @details #' The basis matrix (\code{W}) is updated as follows: #' \deqn{ #' W_{ik} \leftarrow W_{ik} \frac{ sum_j [\frac{H_{kj} A_{ij}}{(WH)_{ij}} ] }{sum_j H_{kj} } #' }{ #' W_ik <- W_ik ( sum_u [H_kl A_il / (WH)_il ] ) / ( sum_l H_kl ) #' } #' @rdname nmf_update_KL #' @export nmf_update.KL.w <- std.divergence.update.w <- function(v, w, h, nbterms=0L, ncterms=0L, copy=TRUE) { .Call("divergence_update_W", v, w, h, nbterms, ncterms, copy, PACKAGE='NMF') } #' @rdname nmf_update_KL #' @export nmf_update.KL.w_R <- R_std.divergence.update.w <- function(v, w, h, wh=NULL) { # compute WH if necessary if( is.null(wh) ) wh <- w %*% h # W_ia = W_ia ( sum_u [H_au A_iu / (WH)_iu ] ) / ( sum_v H_av ) -> each column of W is divided by a the corresponding rowSum of H #x2 <- matrix(rep(rowSums(h), nrow(w)), ncol=ncol(w), byrow=TRUE); #w * tcrossprod(v / wh, h) / x2; sweep(w * tcrossprod(v / wh, h), 2L, rowSums(h), "/", check.margin = FALSE) # optimize version? } #' NMF Multiplicative Updates for Euclidean Distance #' #' Multiplicative updates from \cite{Lee2001} for standard Nonnegative Matrix Factorization #' models \eqn{V \approx W H}, where the distance between the target matrix and its NMF #' estimate is measured by the -- euclidean -- Frobenius norm. #' #' \code{nmf_update.euclidean.w} and \code{nmf_update.euclidean.h} compute the updated basis and coefficient #' matrices respectively. #' They use a \emph{C++} implementation which is optimised for speed and memory usage. #' #' @details #' The coefficient matrix (\code{H}) is updated as follows: #' \deqn{ #' H_{kj} \leftarrow \frac{\max(H_{kj} W^T V)_{kj}, \varepsilon) }{(W^T W H)_{kj} + \varepsilon} #' }{ #' H_kj <- max(H_kj (W^T V)_kj, eps) / ( (W^T W H)_kj + eps ) #' } #' #' These updates are used by the built-in NMF algorithms \code{\link[=Frobenius-nmf]{Frobenius}} and #' \code{\link[=lee-nmf]{lee}}. #' #' @inheritParams nmf_update.KL.h #' @param eps small numeric value used to ensure numeric stability, by shifting up #' entries from zero to this fixed value. #' #' @return a matrix of the same dimension as the input matrix to update #' (i.e. \code{w} or \code{h}). #' If \code{copy=FALSE}, the returned matrix uses the same memory as the input object. #' #' @author #' Update definitions by \cite{Lee2001}. #' #' C++ optimised implementation by Renaud Gaujoux. #' #' @rdname nmf_update_euclidean #' @aliases nmf_update.euclidean #' @export nmf_update.euclidean.h <- std.euclidean.update.h <- function(v, w, h, eps=10^-9, nbterms=0L, ncterms=0L, copy=TRUE){ .Call("euclidean_update_H", v, w, h, eps, nbterms, ncterms, copy, PACKAGE='NMF') } #' \code{nmf_update.euclidean.w_R} and \code{nmf_update.euclidean.h_R} implement the same updates #' in \emph{plain R}. #' #' @param wh already computed NMF estimate used to compute the denominator term. #' #' @rdname nmf_update_euclidean #' @export nmf_update.euclidean.h_R <- R_std.euclidean.update.h <- function(v, w, h, wh=NULL, eps=10^-9){ # compute WH if necessary den <- if( is.null(wh) ) crossprod(w) %*% h else{ t(w) %*% wh} # H_au = H_au (W^T V)_au / (W^T W H)_au pmax(h * crossprod(w,v),eps) / (den + eps); } #' @details #' The basis matrix (\code{W}) is updated as follows: #' \deqn{ #' W_ik \leftarrow \frac{\max(W_ik (V H^T)_ik, \varepsilon) }{ (W H H^T)_ik + \varepsilon} #' }{ #' W_ik <- max(W_ik (V H^T)_ik, eps) / ( (W H H^T)_ik + eps ) #' } #' #' @param weight numeric vector of sample weights, e.g., used to normalise samples #' coming from multiple datasets. #' It must be of the same length as the number of samples/columns in \code{v} #' -- and \code{h}. #' #' @rdname nmf_update_euclidean #' @export nmf_update.euclidean.w <- std.euclidean.update.w <- function(v, w, h, eps=10^-9, nbterms=0L, ncterms=0L, weight=NULL, copy=TRUE){ .Call("euclidean_update_W", v, w, h, eps, weight, nbterms, ncterms, copy, PACKAGE='NMF') } #' @rdname nmf_update_euclidean #' @export nmf_update.euclidean.w_R <- R_std.euclidean.update.w <- function(v, w, h, wh=NULL, eps=10^-9){ # compute WH if necessary den <- if( is.null(wh) ) w %*% tcrossprod(h) else{ wh %*% t(h)} # W_ia = W_ia (V H^T)_ia / (W H H^T)_ia and columns are rescaled after each iteration pmax(w * tcrossprod(v, h), eps) / (den + eps); } ################################################################################################ # AFTER-UPDATE METHODS ################################################################################################ #' Stopping Criteria for NMF Iterative Strategies #' #' The function documented here implement stopping/convergence criteria #' commonly used in NMF algorithms. #' #' \code{NMFStop} acts as a factory method that creates stopping criterion functions #' from different types of values, which are subsequently used by #' \code{\linkS4class{NMFStrategyIterative}} objects to determine when to stop their #' iterative process. #' #' @details #' \code{NMFStop} can take the following values: #' \describe{ #' \item{function}{ is returned unchanged, except when it has no arguments, #' in which case it assumed to be a generator, which is immediately called and should return #' a function that implements the actual stopping criterion;} #' \item{integer}{ the value is used to create a stopping criterion that stops at #' that exact number of iterations via \code{nmf.stop.iteration};} #' \item{numeric}{ the value is used to create a stopping criterion that stops when #' at that stationary threshold via \code{nmf.stop.threshold};} #' \item{character}{ must be a single string which must be an access key #' for registered criteria (currently available: \dQuote{connectivity} and \dQuote{stationary}), #' or the name of a function in the global environment or the namespace of the loading package.} #' } #' #' @param s specification of the stopping criterion. #' See section \emph{Details} for the supported formats and how they are processed. #' @param check logical that indicates if the validity of the stopping criterion #' function should be checked before returning it. #' #' @return a function that can be passed to argument \code{.stop} of function #' \code{\link{nmf}}, which is typically used when the algorith is implemented as #' an iterative strategy. #' #' @aliases stop-NMF #' @rdname stop-NMF #' @export NMFStop <- function(s, check=TRUE){ key <- s fun <- if( is.integer(key) ) nmf.stop.iteration(key) else if( is.numeric(key) ) nmf.stop.threshold(key) else if( is.function(key) ) key else if( is.character(key) ){ # update .stop for back compatibility: if( key == 'nmf.stop.consensus') key <- 'connectivity' # first lookup for a `nmf.stop.*` function key2 <- paste('nmf.stop.', key, sep='') e <- pkgmaker::packageEnv() sfun <- getFunction(key2, mustFind=FALSE, where = e) if( is.null(sfun) ) # lookup for the function as such sfun <- getFunction(key, mustFind = FALSE, where = e) if( is.null(sfun) ) stop("Invalid key ['", key,"']: could not find functions '",key2, "' or '", key, "'") sfun }else if( identical(key, FALSE) ) # create a function that does not stop function(strategy, i, target, data, ...){FALSE} else stop("Invalid key: should be a function, a character string or a single integer/numeric value. See ?NMFStop.") # execute if generator (i.e. no arguments) if( length(formals(fun)) == 0L ) fun <- fun() # check validity if requested if( check ){ n.stop <- names(formals(fun)) if( length(n.stop) < 4 ){ stop("Invalid 'Stop' method - must have at least 4 arguments: ", "NMF strategy object [strategy], ", "current iteration number [i], ", "target matrix [y], ", "current NMF model iterate [x]") } n.stop <- n.stop[-seq(4)] # argument '...' must be present in method 'Stop' if( !is.element('...', n.stop) ) stop("Invalid 'Stop' method: must have argument '...' (even if not used)") } # return function fun } #' \code{nmf.stop.iteration} generates a function that implements the stopping #' criterion that limits the number of iterations to a maximum of \code{n}), #' i.e. that returns \code{TRUE} if \code{i>=n}, \code{FALSE} otherwise. #' #' @param n maximum number of iteration to perform. #' #' @return a function that can be used as a stopping criterion for NMF algorithms #' defined as \code{\linkS4class{NMFStrategyIterative}} objects. #' That is a function with arguments \code{(strategy, i, target, data, ...)} #' that returns \code{TRUE} if the stopping criterion is satisfied -- which in #' turn stops the iterative process, and \code{FALSE} otherwise. #' #' @export #' @family NMFStrategyIterative #' @rdname stop-NMF nmf.stop.iteration <- function(n){ nmf.debug("Using stopping criterion - Fixed number of iterations: ", n) if( !is.numeric(n) ) stop("Invalid argument `n`: must be an integer value") if( length(n) > 1 ) warning("NMF::nmf - Argument `n` [", deparse(substitute(n)), "] has length > 1: only using the first element.") .max <- n[1] function(object, i, y, x, ...) i >= .max } #' \code{nmf.stop.threshold} generates a function that implements the stopping #' criterion that stops when a given stationarity threshold is achieved by #' successive iterations. #' The returned function is identical to \code{nmf.stop.stationary}, but with #' the default threshold set to \code{threshold}. #' #' @param threshold default stationarity threshold #' #' @export #' @rdname stop-NMF nmf.stop.threshold <- function(threshold){ nmf.debug("Using stopping criterion - Stationarity threshold: ", threshold) if( !is.numeric(threshold) ) stop("Invalid argument `threshold`: must be a numeric value") if( length(threshold) > 1 ) warning("NMF::nmf - Argument `threshold` [", deparse(substitute(threshold)), "] has length > 1: only using the first element.") eval(parse(text=paste("function(strategy, i, target, data, stationary.th=", threshold, ", ...){ nmf.stop.stationary(strategy, i, target, data, stationary.th=stationary.th, ...) }"))) } #' \code{nmf.stop.stationary} implements the stopping criterion of stationarity #' of the objective value, which stops when the gradient of the objective function #' is uniformly small over a certain number of iterations. #' #' More precisely, the objective function is computed over \eqn{n} successive iterations (specified #' in argument \code{check.niter}), every \code{check.interval} iterations. #' The criterion stops when the absolute difference between the maximum and the minimum #' objective values over these iterations is lower than a given threshold \eqn{\alpha} #' (specified in \code{stationary.th}): #' #' \deqn{ #' \left| \frac{\max_{i- N_s + 1 \leq k \leq i} D_k - \min_{i - N_s +1 \leq k \leq i} D_k}{n} \right| \leq \alpha, #' }{ #' | [max( D(i- N_s + 1), ..., D(i) ) - min( D(i- N_s + 1), ..., D(i) )] / n | <= alpha #' } #' #' @param object an NMF strategy object #' @param i the current iteration #' @param y the target matrix #' @param x the current NMF model #' @param stationary.th maximum absolute value of the gradient, for the objective #' function to be considered stationary. #' @param check.interval interval (in number of iterations) on which the stopping #' criterion is computed. #' @param check.niter number of successive iteration used to compute the stationnary #' criterion. #' @param ... extra arguments passed to the function \code{\link{objective}}, #' which computes the objective value between \code{x} and \code{y}. #' #' @export #' @rdname stop-NMF nmf.stop.stationary <- local({ # static variable .last.objective.value <- c(-Inf, Inf) .niter <- 0L .store_value <- function(value){ .niter <<- .niter + 1L .last.objective.value <<- c(max(.last.objective.value[1L], value) , min(.last.objective.value[2L], value)) } .reset_value <- function(){ .last.objective.value <<- c(-Inf, Inf) .niter <<- 0L } function(object, i, y, x, stationary.th=.Machine$double.eps, check.interval=5*check.niter, check.niter=10L, ...){ # check validity if( check.interval < check.niter ){ stop("Invalid argument values: `check.interval` must always be greater than `check.niter`") } # initialisation call: compute initial objective value if( i == 0L || (i == 1L && is.null(.last.objective.value)) ){ .reset_value() # give the chance to update once and estimate from a partial model if( is.partial.nmf(x) ) return( FALSE ) # compute initial deviance current.value <- deviance(object, x, y, ...) # check for NaN, i.e. probably infinitely small value (cf. bug reported by Nadine POUKEN SIEWE) if( is.nan(current.value) ) return(TRUE) # store value in static variable for next calls .store_value(current.value) return(FALSE) } # test convergence only every 10 iterations if( .niter==0L && i %% check.interval != 0 ) return( FALSE ); # get last objective value from static variable current.value <- deviance(object, x, y, ...) # check for NaN, i.e. probably infinitely small value (cf. bug reported by Nadine POUKEN SIEWE) if( is.nan(current.value) ) return(TRUE) # update static variables .store_value(current.value) # once values have been computed for check.niter iterations: # check if the difference in the extreme objective values is small enough if( .niter == check.niter+1 ){ crit <- abs(.last.objective.value[1L] - .last.objective.value[2L]) / check.niter if( crit <= stationary.th ){ if( nmf.getOption('verbose') ){ message(crit) } return( TRUE ) } .reset_value() } # do NOT stop FALSE } }) #' \code{nmf.stop.connectivity} implements the stopping criterion that is based #' on the stationarity of the connectivity matrix. #' #' @inheritParams nmf.stop.stationary #' @param stopconv number of iterations intervals over which the connectivity #' matrix must not change for stationarity to be achieved. #' #' @export #' @rdname stop-NMF nmf.stop.connectivity <- local({ # static variables .consold <- NULL .inc <- NULL function(object, i, y, x, stopconv=40, check.interval=10, ...){ if( i == 0L ){ # initialisation call # Initialize consensus variables # => they are static variables within the strategy's workspace so that # they are persistent and available throughout across the calls p <- ncol(x) .consold <<- matrix(0, p, p) .inc <<- 0 return(FALSE) } # test convergence only every 10 iterations if( i %% check.interval != 0 ) return( FALSE ); # retrieve metaprofiles h <- coef(x, all=FALSE) # construct connectivity matrix index <- apply(h, 2, function(x) which.max(x) ) cons <- outer(index, index, function(x,y) ifelse(x==y, 1,0)); changes <- cons != .consold if( !any(changes) ) .inc <<- .inc + 1 # connectivity matrix has not changed: increment the count else{ .consold <<- cons; .inc <<- 0; # else restart counting } # prints number of changing elements #if( verbose(x) ) cat( sprintf('%d ', sum(changes)) ) #cat( sprintf('%d ', sum(changes)) ) # assume convergence is connectivity stops changing if( .inc > stopconv ) return( TRUE ); # do NOT stop FALSE } }) ################################################################################################ # WRAP-UP METHODS ################################################################################################ NMF/R/NMFplots.R0000644000176000001440000005151212305630424012753 0ustar ripleyusers# Plotting functions for NMF objects # # Author: Renaud Gaujoux # Creation: 16 Aug 2011 ############################################################################### #' @include NMFSet-class.R NULL # Scales a matrix so that its columns sum up to one. sum2one <- function(x){ sweep(x, 2L, colSums(x), '/') } #' @import grDevices corplot <- function(x, y, legend=TRUE, confint=TRUE, scales = 'fixed', ..., add=FALSE){ cols <- rainbow(ncol(x)) # set default arguments gpar <- .set.list.defaults(list(...) , ylab=quote(substitute(y)) , xlab=quote(substitute(x)) , main="Correlation plot" , type='p' , pch=19 , cex=0.8 , col=alphacol(cols, alpha=90)) if( is.null(colnames(x)) ) colnames(x) <- paste("column", 1:ncol(x), sep='_') # draw plot using matplot pfun <- if( add ) matpoints else matplot #do.call(pfun, c(list(x, y), gpar)) # add perfect match line #abline(a=0, b=1) # initialise result res <- list(global=list()) gco <- lm(as.numeric(y) ~ as.numeric(x)) res$global$lm <- gco grsq <- CI.Rsqlm(gco) res$global$cortest <- cor.test( as.numeric(x), as.numeric(y) ) grsq$rho <- res$global$cortest$estimate grsq$alpha <- res$global$lm$coef[2L] # add legend if requested x <- provideDimnames(x, base = list(as.character(1:max(dim(x))))) y <- provideDimnames(y, base = list(as.character(1:max(dim(y))))) ct.labs <- colnames(x) if( legend ){ # separate correlations res$local <- list(lm=list(), cortest=list()) lco <- t(sapply(1:ncol(x), function(i){ co <- lm(y[,i] ~ x[,i]) res$local$lm[[i]] <<- co cotest <- cor.test( as.numeric(x[, i]), as.numeric(y[, i]) ) res$local$cortest[[i]] <<- cotest rsq <- CI.Rsqlm(co) return(round(c(Rsq=rsq$Rsq , confint=rsq$UCL - rsq$Rsq , rho=cotest$estimate , alpha=co$coef[2L]), 2)) # z <- as.numeric(cor.test(x[,i], y[,i])[c('estimate', 'p.value')]) # z[1] <- round.pretty(z[1], 2) # z[2] <- round.pretty(z[2], 3) # z } )) # ct.labs <- sapply(seq_along(ct.labs), function(i){ ci <- if( confint ) str_c(' +/- ', lco[i,2]) else '' bquote(.(sprintf('%s (', colnames(y)[i])) ~ alpha == .(sprintf(' %0.2f | ', lco[i,4])) ~ rho == .(sprintf(' %.02f | ', lco[i,3])) ~ R^2 == .(sprintf(' %0.2f %s)', lco[i,1], ci))) }) } df <- data.frame(x = melt(x), y = melt(y)) df[[5L]] <- factor(df[[5L]], levels = colnames(y)) ct <- colnames(df)[5L] ct.title <- gsub('y.', '', ct, fixed = TRUE) p <- ggplot(df, aes_string(x='x.value', y='y.value' , color = ct)) + geom_point() + xlab(gpar$xlab) + ylab(gpar$ylab) + scale_color_discrete(labels = ct.labs) + stat_smooth(method = lm) + geom_abline(slope = 1, linetype = 3) + facet_grid(paste0('~ ', ct), scales = scales) + labs(color = ct.title) if( legend ){ p <- p + theme(legend.position = 'bottom') + guides(color = guide_legend(ncol = 1)) }else{ p <- p + theme(legend.position = 'none') } p$correlations <- res p } #setMethod('corplot', signature(x='NMFfitXn', y='NMF') # , function(x, y, pch=19, ...){ # # i <- 1 # i0 <- which.best(x) # i2 <- which.best(x, maxAD, y) # .local <- function(f, skip, order, ...){ # # # reorder if necessary # if( !missing(order) && !is.null(order) ) # f <- match.nmf(f, order) # # # skip if needed # if( i == skip ) # return() # # # compute correlations between profiles # co <- diag(cor(t(scoef(f)), t(scoef(y)))) # if( i == 1 ){ # mp <- plot(co, ylim=c(-1,1), xaxt='n', ...) # mtext(side = 1, basisnames(y), at= 1:nbasis(y), line = 1) # } # else # lines(co, ...) # i <<- i+1 # # } # lapply(x, .local, skip=i0, col="#00000010", type='l', ...) # .local(x[[i0]], 0, col="red", type='o', pch=19, ...) # .local(x[[i2]], 0, col="red", type='o', pch=19, lty='dashed', ...) # invisible() # # } #) #' Plotting Expression Profiles #' #' @export profplot <- function(x, ...){ UseMethod('profplot') } #' #' The function \code{profplot} draws plots of the basis profiles, i.e. the rows #' of the coefficient matrix of NMF models. #' A given profile is composed of the contribution of the corresponding #' basis to each sample. #' #' When using NMF for clustering in particular, one looks for strong #' associations between the basis and a priori known groups of samples. #' Plotting the profiles may highlight such patterns. #' #' The function can also be used to compare the profiles from two NMF models or #' mixture coefficient matrices. In this case, it draws a scatter plot of the #' paired profiles. #' #' @param x a matrix or an NMF object from which is extracted the mixture #' coefficient matrix. It is extracted from the best fit if \code{x} is the #' results from multiple NMF runs. #' @param y a matrix or an NMF object from which is extracted the mixture #' coefficient matrix. #' It is extracted from the best fit if \code{y} is the results from multiple NMF runs. #' @param scale specifies how the data should be scaled before plotting. #' If \code{'none'} or \code{NA}, then no scaling is applied and the "raw" data is plotted. #' If \code{TRUE} or \code{'max'} then each row of both matrices #' are normalised with their respective maximum values. #' If \code{'c1'}, then each column of both matrix is scaled into proportions (i.e. to sum up to one). #' Default is \code{'none'}. #' @param match.names a logical that indicates if the profiles in \code{y} #' should be subset and/or re-ordered to match the profile names in \code{x} #' (i.e. the rownames). This is attempted only when both \code{x} and \code{y} #' have names. #' @param legend a logical that specifies whether drawing the legend or not, or #' coordinates specifications passed to argument \code{x} of #' \code{\link{legend}}, that specifies the position of the legend. #' @param confint logical that indicates if confidence intervals for the #' R-squared should be shown in legend. #' @param Colv specifies the way the columns of \code{x} are ordered before #' plotting. It is used only when \code{y} is missing. It can be: \itemize{ #' \item a single numeric value, specifying the index of a row of \code{x}, #' that is used to order the columns by \code{x[, order(x[abs(Colv),])]}. #' Decreasing order is specified with a negative index. \item an integer #' vector directly specifying the order itself, in which case the columns are #' ordered by \code{x[, Colv]} \item a factor used to order the columns by #' \code{x[, order(Colv)]} and as argument \code{annotation} if this latter is #' missing or not \code{NA}. \item any other object with a suitable #' \code{order} method. The columns are by \code{x[, order(Colv)]} } #' @param labels a character vector containing labels for each sample (i.e. #' each column of \code{x}). These are used for labelling the x-axis. #' @param annotation a factor annotating each sample (i.e. each column of #' \code{x}). If not missing, a coloured raw is plotted under the x-axis and #' annotates each sample accordingly. If argument \code{Colv} is a factor, then #' it is used to annotate the plot, unless \code{annotation=NA}. #' @param ... graphical parameters passed to \code{\link{matplot}} or \code{\link{matpoints}}. #' @param add logical that indicates if the plot should be added as points to a previous plot #' #' @seealso \code{\link{profcor}} #' @keywords aplot #' @rdname profplot #' @export #' @S3method profplot default #' @examples #' #' # create a random target matrix #' v <- rmatrix(50, 10) #' #' # fit a single NMF model #' res <- nmf(v, 3) #' profplot(res) #' #' # ordering according to first profile #' profplot(res, Colv=1) # increasing #' profplot(res, Colv=-1) # decreasing #' #' # fit a multi-run NMF model #' res2 <- nmf(v, 3, nrun=3) #' profplot(res2) #' #' # draw a profile correlation plot: this show how the basis components are #' # returned in an unpredictable order #' profplot(res, res2) #' #' # looking at all the correlations allow to order the components in a "common" order #' profcor(res, res2) #' profplot.default <- function(x, y, scale=c('none', 'max', 'c1'), match.names=TRUE , legend=TRUE, confint=TRUE , Colv, labels, annotation, ..., add = FALSE){ # initialise result list res <- list() # get extra graphical parameters gpar <- list(...) # plot a correlation plot of y is not missing if( !missing(y) ){ xvar <- deparse(substitute(x)) # extract mixture coefficient from x if( isNMFfit(x) ){ gpar <- .set.list.defaults(gpar , xlab=paste("NMF model", xvar, "- Method:", algorithm(x))) x <- fit(x) } if( is.nmf(x) ){ gpar <- .set.list.defaults(gpar , main="Mixture coefficient profile correlations" , xlab=paste("NMF model", xvar)) x <- coef(x) if( is.null(rownames(x)) ) rownames(x) <- paste("basis", 1:nrow(x), sep='_') }else if( is(x, 'ExpressionSet') ){ x <- Biobase::exprs(x) gpar <- .set.list.defaults(gpar , main="Expression profile correlations" , xlab=paste("ExpressionSet", xvar)) }else{ gpar <- .set.list.defaults(gpar , xlab=paste("Matrix ", xvar)) } # at this stage x must be a matrix if( !is.matrix(x) ) stop("NMF::profplot - Invalid argument `x`: could not extract mixture coefficient matrix") # extract mixture coefficient from y yvar <- deparse(substitute(y)) if( isNMFfit(y) ){ gpar <- .set.list.defaults(gpar , ylab=paste("NMF model", yvar, "- Method:", algorithm(y))) y <- fit(y) } if( is.nmf(y) ){ gpar <- .set.list.defaults(gpar , main="Mixture coefficient profile correlations" , ylab=paste("NMF model", yvar)) y <- coef(y) }else if( is(y, 'ExpressionSet') ){ y <- Biobase::exprs(y) gpar <- .set.list.defaults(gpar , main="Expression profile correlations" , ylab=paste("ExpressionSet", yvar)) }else{ gpar <- .set.list.defaults(gpar , ylab=paste("Matrix ", yvar)) } # at this stage y must be a matrix if( !is.matrix(y) ) stop("NMF::profplot - Invalid argument `y`: could not extract profile matrix") # match names if requested if( match.names && !is.null(rownames(x)) && !is.null(rownames(y)) ){ # match the row in x to the rows in y y.idx <- match(rownames(x), rownames(y), nomatch=0L) x.idx <- which(y.idx!=0L) # subset and reorder if possible if( length(x.idx) > 0L ){ res$y.idx <- y.idx[x.idx] y <- y[y.idx, , drop = FALSE] res$x.idx <- x.idx x <- x[x.idx, , drop = FALSE] } } # scale to proportions if requested if( missing(scale) ) scale <- NULL else if( isTRUE(scale) ) scale <- 'max' else if( isFALSE(scale) ) scale <- 'none' scale <- match.arg(scale) scales <- 'free' if( scale == 'max' ){ gpar <- .set.list.defaults(gpar , xlim=c(0,1), ylim=c(0,1)) # scale x iscale <- (xm <- apply(abs(x), 1L, max)) > 0 x[iscale, ] <- sweep(x[iscale, , drop = FALSE], 1L, xm[iscale], '/') # scale y iscale <- (ym <- apply(abs(y), 1L, max)) > 0 y[iscale, ] <- sweep(y[iscale, , drop = FALSE], 1L, ym[iscale], '/') scales <- 'fixed' } else if( scale == 'c1' ){ gpar <- .set.list.defaults(gpar , xlim=c(0,1), ylim=c(0,1)) x <- sum2one(x) y <- sum2one(y) }else{ Mx <- max(x, y); mx <- min(x, y) # extend default limits by a 0.25 factor Mx <- Mx * 1.25 mx <- mx * 0.75 gpar <- .set.list.defaults(gpar , xlim=c(mx,Mx), ylim=c(mx,Mx)) } gpar <- .set.list.defaults(gpar , main="Profile correlations") # plot the correlation plot p <- do.call(corplot, c(list(x=t(x), y=t(y), scales = scales, legend=legend, confint=confint, add=add), gpar)) p <- expand_list(p, list(idx.map = res)) # return result list return( p ) } # extract mixture coefficient xvar <- deparse(substitute(x)) if( isNMFfit(x) ){ gpar <- .set.list.defaults(gpar, main=paste("Mixture coefficient profiles\nNMF method:", algorithm(x), "- runs:", nrun(x))) x <- fit(x) } if( is.nmf(x) ){ gpar <- .set.list.defaults(gpar, main="Mixture coefficient profiles") x <- coef(x) }else if( is(x, 'ExpressionSet') ){ x <- Biobase::exprs(x) gpar <- .set.list.defaults(gpar, main="Expression profiles") } # at this stage x must be a matrix if( !is.matrix(x) ) stop("NMF::profplot - Invalid argument `x`: could not extract profile matrix") # scale to proportions if requested if( missing(scale) || !isTRUE(scale) ) scale <- FALSE if( scale ){ gpar <- .set.list.defaults(gpar, ylim=c(0,1)) x <- sum2one(x) } # reorder the samples if requested if( missing(labels) ){ labels <- if( !is.null(colnames(x)) ) colnames(x) else 1:ncol(x) } else if( length(labels) != ncol(x) ){ labels <- rep(labels, length.out=ncol(x)) # stop("NMF::profplot - Invalid argument `labels`: length should be equal to the number of columns in ", xvar, " [=", ncol(x),"]") } # check annotation if( !missing(annotation) && length(annotation) != ncol(x) ) stop("NMF::profplot - Invalid argument `annotation`:: length should be equal to the number of columns in ", xvar, " [=", ncol(x),"]") # reorder the columns if requested if( !missing(Colv) && !is_NA(Colv) ){ ord <- if( length(Colv) == 1 ){ if( !is.numeric(Colv) || abs(Colv) > nrow(x) ) stop("NMF::profplot - Invalid singel argument `Colv`: should be an integer between -nrow(x) and nrow(", xvar,") (i.e. [[-", nrow(x),",", nrow(x),"]])") order(x[abs(Colv),], decreasing=Colv<0) }else{ if( length(Colv) != ncol(x) ) stop("NMF::profplot - Invalid length for argument `Colv`: should be of length ncol(", xvar, ") [=", nrow(x),"]") if( is.integer(Colv) && length(setdiff(Colv, 1:ncol(x)))==0 ) Colv else order(Colv) } # use Colv as annotation if not requested otherwise if( missing(annotation) && is.factor(Colv) ) annotation <- Colv # reorder all relevant quantities x <- x[,ord] labels <- labels[ord] if( !missing(annotation) && !is_NA(annotation) ) annotation <- annotation[ord] } # set default arguments cols <- rainbow(nrow(x)) gpar <- .set.list.defaults(gpar , xlab="Samples" , ylab="Mixture coefficient value" , main="Profile plot" , type='o' , lty=1 , pch=19 , cex=0.8 , col=cols) # plot using matplot do.call(matplot, c(list(x=t(x)), gpar, xaxt='n')) # add legend if requested if( !isFALSE(legend) ){ if( isTRUE(legend) ) legend <- 'topleft' # use the rownames for the legend leg <- rownames(x) if( is.null(leg) ) leg <- paste('basis', 1:nrow(x), sep='_') legend(legend, legend=leg, col=gpar$col, lwd=1, pch=gpar$pch) } # axis ticks px <- 1:ncol(x) axis(1, at = px, labels = FALSE) # setup grid-base mixed graphic vps <- baseViewports() pushViewport(vps$inner, vps$figure, vps$plot) # clean up on exit on.exit(popViewport(3), add=TRUE) voffset <- 1 # add sample annotation if( !missing(annotation) && !is_NA(annotation) && is.factor(annotation) ){ grid.rect(x = unit(px, "native"), unit(-voffset, "lines") , width = unit(1, 'native'), height = unit(1, "lines") , gp = gpar(fill=alphacol(rainbow(nlevels(annotation))[annotation], 50), col = 'gray')) voffset <- voffset+1 } # add labels if( !is_NA(labels) ){ # setup grid-base mixed graphic #library(gridBase) #vps <- baseViewports() #pushViewport(vps$inner, vps$figure, vps$plot) # add axis adj <- if( is.character(labels) && max(nchar(labels)) >= 7 ) list(just='right', rot=45) else list(just='center', rot=0) grid.text(labels , x = unit(px, "native"), y = unit(-voffset,"lines") , just = adj$just, rot = adj$rot) voffset <- voffset+1 # clean up on exit #popViewport(3) } invisible(nrow(x)) # add xlab #if( nchar(xlab) > 0 ) # grid.text(xlab, x = unit(length(px)/2, "native"), y = unit(-voffset,"lines"), just = 'center') } #setGeneric('profplot', function(x, y, ...) standardGeneric('profplot')) #setMethod('profplot', signature(x='matrix', y='missing') # , function(x, y, ...){ # # gpar <- .set.list.defaults(list(...) # , xlim=c(0,1), ylim=c(0,1) # , main="Profile plot" # , type='b' # , pch=19) # # do.call(matplot, c(gpar, x=t(sum2one(x)), y=t(sum2one(y)))) # } #) #setMethod('profplot', signature(x='matrix', y='matrix') # , function(x, y, scale=FALSE, ...){ # # # x is the reference, y the estimation # if( scale ){ # gpar <- .set.list.defaults(list(...) # , xlim=c(0,1), ylim=c(0,1) # , main="Profile correlation plot") # do.call(corplot, c(gpar, x=t(sum2one(x)), y=t(sum2one(y)))) # }else # corplot(t(x), t(y), ...) # # } #) #setMethod('profplot', signature(x='matrix', y='NMF') # , function(x, y, ...){ # profplot(x, coef(y), ...) # } #) #setMethod('profplot', signature(x='NMF', y='ANY') # , function(x, y, ...){ # profplot(coef(x), y, ...) # } #) #setMethod('profplot', signature(x='matrix', y='NMFfit') # , function(x, y, ...){ # # if( !missing(y) ){ # x is the reference, y the estimation # # # map components to the references # title <- paste("Profile correlation plot - Method:", algorithm(y)) # gpar <- .set.list.defaults(list(...), # list(main=title)) # do.call(profplot, c(gpar, x=x, y=fit(y))) # } # } #) #setMethod('profplot', signature(x='matrix', y='NMFfitXn') # , function(x, y, ...){ # profplot(x, minfit(y), ...) # } #) #setMethod('profplot', signature(x='NMFfitXn', y='ANY') # , function(x, y, ...){ # profplot(minfit(x), y, ...) # } #) #' Silhouette of NMF Clustering #' #' @param x an NMF object, as returned by \code{\link{nmf}}. #' @param what defines the type of clustering the computed silhouettes are #' meant to assess: \code{'samples'} for the clustering of samples #' (i.e. the columns of the target matrix), #' \code{'features'} for the clustering of features (i.e. the rows of the #' target matrix), and \code{'chc'} for the consensus clustering of samples as #' defined by hierarchical clustering dendrogram, \code{'consensus'} for the #' consensus clustering of samples, with clustered ordered as in the #' \strong{default} hierarchical clustering used by #' \code{\link{consensusmap}} when plotting the heatmap of the consensus matrix #' (for multi-run NMF fits). #' That is \code{dist = 1 - consensus(x)}, average linkage and reordering based #' on row means. #' @param order integer indexing vector that can be used to force the silhouette #' order. #' @param ... extra arguments not used. #' #' @seealso \code{\link[NMF]{predict}} #' @S3method silhouette NMF #' @import cluster #' @examples #' #' x <- rmatrix(100, 20, dimnames = list(paste0('a', 1:100), letters[1:20])) #' # NB: using low value for maxIter for the example purpose only #' res <- nmf(x, 4, nrun = 5, maxIter = 50) #' #' # sample clustering from best fit #' plot(silhouette(res)) #' #' # from consensus #' plot(silhouette(res, what = 'consensus')) #' #' # feature clustering #' plot(silhouette(res, what = 'features')) #' #' # average silhouette are computed in summary measures #' summary(res) #' #' # consensus silhouettes are ordered as on default consensusmap heatmap #' \dontrun{ op <- par(mfrow = c(1,2)) } #' consensusmap(res) #' si <- silhouette(res, what = 'consensus') #' plot(si) #' \dontrun{ par(op) } #' #' # if the order is based on some custom numeric weights #' \dontrun{ op <- par(mfrow = c(1,2)) } #' cm <- consensusmap(res, Rowv = runif(ncol(res))) #' # NB: use reverse order because silhouettes are plotted top-down #' si <- silhouette(res, what = 'consensus', order = rev(cm$rowInd)) #' plot(si) #' \dontrun{ par(op) } #' #' # do the reverse: order the heatmap as a set of silhouettes #' si <- silhouette(res, what = 'features') #' \dontrun{ op <- par(mfrow = c(1,2)) } #' basismap(res, Rowv = si) #' plot(si) #' \dontrun{ par(op) } #' silhouette.NMF <- function(x, what = NULL, order = NULL, ...){ # compute prediction p <- predict(x, what = what, dmatrix = TRUE) # compute silhouette si <- silhouette(as.numeric(p), dmatrix = attr(p, 'dmatrix')) attr(si, 'call') <- match.call(call = sys.call(-1)) if( is_NA(si) ) return(NA) # fix rownames if necessary if( is.null(rownames(si)) ){ rownames(si) <- names(p) if( is.null(rownames(si)) ) rownames(si) <- 1:nrow(si) } if( is.null(order) && !is.null(attr(p, 'iOrd')) ){ # reorder as defined in prediction order <- attr(p, 'iOrd') } # order the silhouette if( !is.null(order) && !is_NA(order) ){ si[1:nrow(si), ] <- si[order, , drop = FALSE] rownames(si) <- rownames(si)[order] attr(si, 'iOrd') <- order attr(si, 'Ordered') <- TRUE } si } #' @S3method silhouette NMFfitX silhouette.NMFfitX <- function(x, ...){ si <- silhouette.NMF(x, ...) attr(si, 'call') <- match.call(call = sys.call(-1)) si } NMF/R/data.R0000644000176000001440000000407112307621244012162 0ustar ripleyusers# Description and generation of data # # Author: Renaud Gaujoux ############################################################################### #' Golub ExpressionSet #' #' This data comes originally from the gene expression data from \cite{Golub1999}. #' The version included in the package is the one used and referenced in \cite{Brunet2004}. #' The samples are from 27 patients with acute lymphoblastic leukemia (ALL) and #' 11 patients with acute myeloid leukemia (AML). #' #' The samples were assayed using Affymetrix Hgu6800 chips and the original #' data on the expression of 7129 genes (Affymetrix probes) are available on #' the Broad Institute web site (see references below). #' #' The data in \code{esGolub} were obtained from the web page related to #' the paper from \cite{Brunet2004}, which describes an application of #' Nonnegative Matrix Factorization to gene expression clustering. #' (see link in section \emph{Source}). #' #' They contain the 5,000 most highly varying genes according to their #' coefficient of variation, and were installed in an object of class #' \code{\link[Biobase]{ExpressionSet-class}}. #' #' @format There are 3 covariates listed. #' #' \itemize{ #' #' \item Samples: The original sample labels. \item ALL.AML: Whether the #' patient had AML or ALL. It is a \code{\link{factor}} with levels #' \code{c('ALL', 'AML')}. \item Cell: ALL arises from two different types of #' lymphocytes (T-cell and B-cell). This specifies which for the ALL patients; #' There is no such information for the AML samples. It is a #' \code{\link{factor}} with levels \code{c('T-cell', 'B-cell', NA)}. #' #' } #' #' @source #' Web page for \cite{Brunet2004}:\cr #' \url{http://www.broadinstitute.org/publications/broad872} #' #' Original data from Golub et al.:\cr #' \url{http://www-genome.wi.mit.edu/mpr/data_set_ALL_AML.html} #' #' @name esGolub #' @docType data #' @keywords datasets #' @examples #' #' # requires package Biobase to be installed #' if( require(Biobase) ){ #' #' data(esGolub) #' esGolub #' \dontrun{pData(esGolub)} #' #' } #' NULL NMF/R/simulation.R0000644000176000001440000001211212234465004013427 0ustar ripleyusers# Functions to simulate NMF data # # Author: Renaud Gaujoux ############################################################################### #' @include utils.R NULL #' Simulating Datasets #' #' The function \code{syntheticNMF} generates random target matrices that follow #' some defined NMF model, and may be used to test NMF algorithms. #' It is designed to designed to produce data with known or clear classes of #' samples. #' #' @param n number of rows of the target matrix. #' @param r specification of the factorization rank. #' It may be a single \code{numeric}, in which case argument \code{p} is required #' and \code{r} groups of samples are generated from a draw from a multinomial #' distribution with equal probabilities, that provides their sizes. #' #' It may also be a numerical vector, which contains the number of samples in #' each class (i.e integers). In this case argument \code{p} is discarded #' and forced to be the sum of \code{r}. #' @param p number of columns of the synthetic target matrix. #' Not used if parameter \code{r} is a vector (see description of argument \code{r}). #' @param offset specification of a common offset to be added to the synthetic target #' matrix, before noisification. #' Its may be a numeric vector of length \code{n}, or a single numeric value that #' is used as the standard deviation of a centred normal distribution from which #' the actual offset values are drawn. #' @param noise a logical that indicate if noise should be added to the #' matrix. #' @param factors a logical that indicates if the NMF factors should be return #' together with the matrix. #' @param seed a single numeric value used to seed the random number generator #' before generating the matrix. #' The state of the RNG is restored on exit. #' #' @return a matrix, or a list if argument \code{factors=TRUE}. #' #' When \code{factors=FALSE}, the result is a matrix object, with the following attributes set: #' \describe{ #' \item{coefficients}{the true underlying coefficient matrix (i.e. \code{H});} #' \item{basis}{the true underlying coefficient matrix (i.e. \code{H});} #' \item{offset}{the offset if any;} #' \item{pData}{a \code{list} with one element \code{'Group'} that contains a factor #' that indicates the true groups of samples, i.e. the most contributing basis component for each sample;} #' \item{fData}{a \code{list} with one element \code{'Group'} that contains a factor #' that indicates the true groups of features, i.e. the basis component #' to which each feature contributes the most.} #' } #' #' Moreover, the result object is an \code{\link{ExposeAttribute}} object, which means that #' relevant attributes are accessible via \code{$}, e.g., \code{res$coefficients}. #' In particular, methods \code{\link{coef}} and \code{\link{basis}} will work as expected #' and return the true underlying coefficient and basis matrices respectively. #' #' @export #' @examples #' #' # generate a synthetic dataset with known classes: 50 features, 18 samples (5+5+8) #' n <- 50 #' counts <- c(5, 5, 8) #' #' # no noise #' V <- syntheticNMF(n, counts, noise=FALSE) #' \dontrun{aheatmap(V)} #' #' # with noise #' V <- syntheticNMF(n, counts) #' \dontrun{aheatmap(V)} #' syntheticNMF <- function(n, r, p, offset=NULL, noise=TRUE, factors=FALSE, seed=NULL){ # set seed if necessary if( !is.null(seed) ){ os <- RNGseed() on.exit( RNGseed(os) ) set.seed(seed) } # internal parameters mu.W <- 1; sd.W <- 1 if( isTRUE(noise) ){ noise <- list(mean=0, sd=1) }else if( isNumber(noise) ){ noise <- list(mean=0, sd=noise) }else if( is.list(noise) ){ stopifnot( length(noise) == 2L ) noise <- setNames(noise, c('mean', 'sd')) }else noise <- FALSE if( length(r) == 1 ){ g <- rmultinom(1, p, rep(1, r)) }else{ # elements of r are the number of samples in each class g <- r p <- sum(r) # total number of samples r <- length(r) # number of class } # generate H H <- matrix(0, r, p) tmp <- 0 for( i in 1:r ){ H[i,(tmp+1):(tmp+g[i])] <- 1 tmp <- tmp+g[i] } if( length(n) == 1 ){ b <- rmultinom(1, n, rep(1, r)) }else{ # elements of n are the number of genes in each class b <- n n <- sum(n) } # generate W W <- matrix(0, n, r) tmp <- 0 for( i in 1:r ){ W[(tmp+1):(tmp+b[i]),i] <- abs(rnorm(b[i], mu.W, sd.W)) tmp <- tmp + b[i] } # build the composite matrix res <- W %*% H # add the offset if necessary if( !is.null(offset) ){ if( length(offset) == 1L ) offset <- rnorm(n, mean=0, sd=offset) stopifnot(length(offset)==n) res <- res + offset } # add some noise if required if( !isFALSE(noise) ) res <- pmax(res + rmatrix(res, dist=rnorm, mean=noise$mean, sd=noise$sd), 0) # return the factors if required pData <- list(Group=factor(unlist(mapply(rep, 1:r, g, SIMPLIFY=FALSE)))) fData <- list(Group=factor(unlist(mapply(rep, 1:r, b, SIMPLIFY=FALSE)))) if( factors ) res <- list(res, W=W, H=H, offset=offset, pData=pData, fData=fData) # wrap results and expose relevant attributes ExposeAttribute(res, coefficients=H, basis=W, offset=offset , pData = pData, fData = fData , .VALUE=TRUE, .MODE='r') } NMF/R/seed-ica.R0000644000176000001440000000245312530677623012737 0ustar ripleyusers#' @include registry-seed.R NULL ###% Seeding method: Absolute Independent Component Analysis ###% ###% @author Renaud Gaujoux ###% @creation 17 Jul 2009 ###% Seeding method for Nonnegative Matrix Factorization (NMF) algorithms. ###% ###% @param object An instance of class \code{NMF} to seed ###% @param x The target matrix ###% @param method The method parameter passed to \code{fastICA}. Can either be 'R' or 'C' and ###% tells which implementation of fastICA to use (R code or C code). ###% @param ... extra parameters passed to \code{fastICA} ###% ###% @return an updated version of \code{object}, where the matrix slots \code{W} and \code{H} ###% are set to the positive part of the IC of \code{x}. ###% posICA <- function(object, x, ica.method=c('C', 'R'), ...){ # perform ICA using the fastICA package if( !require.quiet('fastICA') ) stop("Seeding method 'ica' requires package `fastICA` to be installed") requireNamespace('fastICA') ica.method <- match.arg(ica.method) res <- fastICA::fastICA(x, nbasis(object), method=ica.method, ...) # update the 'NMF' object .basis(object) <- pmax(res$S, .Machine$double.eps ); .coef(object) <- pmax(res$A, .Machine$double.eps ); # return the updated object invisible(object) } # Register positive ICA setNMFSeed('ica', posICA, overwrite=TRUE) NMF/R/setNMFClass.R0000644000176000001440000000305312234465004013371 0ustar ripleyusers# Factory method for NMF model classes # # Author: Renaud Gaujoux # Creation: 18 Jul 2012 ############################################################################### #' @include NMF-class.R NULL if( FALSE ){ #START_DEACTIVATE ## #' Factory Method for NMF Model Classes ## #' ## #' Defines two S4 classes for representing NMF models: one to hold data from ## #' the actual model, the other one to hold fitting data for model estimated with ## #' the function \code{\link{nmf}}. ## #' #setNMFClass <- function(Class, ..., where=topns(), contains='NMFstd', VERBOSE=TRUE){ # # # add 'NMF' to contains if necessary # wNMF <- sapply(contains, isNMFclass) # if( !length(wNMF) || !any(wNMF) ){ # contains <- c(contains, 'NMFstd') # parentNMFClass <- 'NMFstd' # }else{ # parentNMFClass <- contains[which(wNMF)] # } # # # extract NMF prefix if present # Class <- sub('^NMF(.*)', "\\1", Class) # # define class names # NMFClass <- str_c('NMF', Class) # NMFfitClass <- str_c(NMFClass, '_fit') # if( VERBOSE ){ # message("Defining NMF classes: ", NMFClass , "(", parentNMFClass , ") and " # , NMFfitClass, ' in ', str_ns(where), ' ... ' # , appendLF=FALSE) # } # # 1. Create model class # setClass(NMFClass, ..., where=where, contains=contains) # # # 2. Create model fit class (in the same environment as the model class) # e <- packageEnv(getClassDef(NMFClass)@package) # setClass(NMFfitClass, where=e, contains=c('NMFfit', NMFClass)) # # if( VERBOSE ) message('OK') # # # return the name of the two new classes # c(NMFClass, NMFfitClass) #} }#END_DEACTIVATE NMF/R/algorithms-base.R0000644000176000001440000004236312234465004014337 0ustar ripleyusers# Standard NMF algorithms # # Author: Renaud Gaujoux # Creation: 30 Apr 2012 ############################################################################### #' @include NMFstd-class.R #' @include NMFOffset-class.R #' @include NMFns-class.R #' @include registry-algorithms.R NULL ################################################################################ # BRUNET (standard KL-based NMF) ################################################################################ #' NMF Algorithm/Updates for Kullback-Leibler Divergence #' #' The built-in NMF algorithms described here minimise #' the Kullback-Leibler divergence (KL) between an NMF model and a target matrix. #' They use the updates for the basis and coefficient matrices (\eqn{W} and \eqn{H}) #' defined by \cite{Brunet2004}, which are essentially those from \cite{Lee2001}, #' with an stabilisation step that shift up all entries from zero every 10 iterations, #' to a very small positive value. #' #' @param i current iteration number. #' @param v target matrix. #' @param x current NMF model, as an \code{\linkS4class{NMF}} object. #' @param eps small numeric value used to ensure numeric stability, by shifting up #' entries from zero to this fixed value. #' @param ... extra arguments. These are generally not used and present #' only to allow other arguments from the main call to be passed to the #' initialisation and stopping criterion functions (slots \code{onInit} and #' \code{Stop} respectively). #' @inheritParams nmf_update.KL.h #' #' @author #' Original implementation in MATLAB: Jean-Philippe Brunet \email{brunet@@broad.mit.edu} #' #' Port to R and optimisation in C++: Renaud Gaujoux #' #' @source #' #' Original MATLAB files and references can be found at: #' #' \url{http://www.broadinstitute.org/mpr/publications/projects/NMF/nmf.m} #' #' \url{http://www.broadinstitute.org/publications/broad872} #' #' Original license terms: #' #' This software and its documentation are copyright 2004 by the #' Broad Institute/Massachusetts Institute of Technology. All rights are reserved. #' This software is supplied without any warranty or guaranteed support whatsoever. #' Neither the Broad Institute nor MIT can not be responsible for its use, misuse, #' or functionality. #' #' @details #' \code{nmf_update.brunet_R} implements in pure R a single update step, i.e. it updates #' both matrices. #' #' @export #' @rdname KL-nmf #' @aliases KL-nmf nmf_update.brunet_R <- function(i, v, x, eps=.Machine$double.eps, ...) { # retrieve each factor w <- .basis(x); h <- .coef(x); # standard divergence-reducing NMF update for H h <- R_std.divergence.update.h(v, w, h) # standard divergence-reducing NMF update for W w <- R_std.divergence.update.w(v, w, h) #every 10 iterations: adjust small values to avoid underflow if( i %% 10 == 0 ){ #precision threshold for numerical stability #eps <- .Machine$double.eps h[h 1 ) 'par' else 'seq' # toogle verbosity , verbose=FALSE # toogle debug mode , debug=FALSE , RESET=TRUE) #' \code{nmf.options} sets/get single or multiple options, that are specific #' to the NMF package. #' It behaves in the same way as \code{\link[base]{options}}. #' #' @inheritParams base::options #' @param ... option specifications. For \code{nmf.options} this can be named arguments or #' a single unnamed argument that is a named list (see \code{\link{options}}. #' #' For \code{nmf.resetOptions}, this must be the names of the options to reset. #' Note that \pkg{pkgmaker} version >= 0.9.1 is required for this to work correctly, #' when options other than the default ones have been set after the package is loaded. #' #' @export #' @rdname options #' @examples #' #' # show all NMF specific options #' nmf.printOptions() #' #' # get some options #' nmf.getOption('verbose') #' nmf.getOption('pbackend') #' # set new values #' nmf.options(verbose=TRUE) #' nmf.options(pbackend='mc', default.algorithm='lee') #' nmf.printOptions() #' #' # reset to default #' nmf.resetOptions() #' nmf.printOptions() #' nmf.options <- .OPTIONS$options #' \code{nmf.getOption} returns the value of a single option, that is specific #' to the NMF package. #' It behaves in the same way as \code{\link[base]{getOption}}. #' #' @inheritParams base::getOption #' #' @export #' @rdname options nmf.getOption <- .OPTIONS$getOption #' \code{nmf.resetOptions} reset all NMF specific options to their default values. #' #' @param ALL logical that indicates if options that are not part of the default set #' of options should be removed. #' Note that in \pkg{pkgmaker <= 0.9} this argument is only taken into account when #' no other argument is present. This is fixed in version 0.9.1. #' #' @export #' @rdname options nmf.resetOptions <- .OPTIONS$resetOptions #' \code{nmf.printOptions} prints all NMF specific options along with their default values, #' in a relatively compact way. #' @export #' @rdname options nmf.printOptions <- .OPTIONS$printOptions #nmf.options.runtime <- function(){ # nmf.options(.nmf.Options.Runtime) #} # debugging utility nmf.debug <- function(fun, ...){ if( nmf.getOption('debug') ){ call.stack <- sys.calls() n <- length(call.stack) if( is.null(fun) ) fun <- as.character(call.stack[[n-1]]) message('DEBUG::', fun, ' -> ', ...) } return(invisible()) } NMF/R/NMF-class.R0000644000176000001440000026222512305630424013001 0ustar ripleyusers#library(R.utils) #' @include utils.R #' @include versions.R #' @include algorithmic.R #' @include aheatmap.R NULL #' Advanced Usage of the Package NMF #' #' The functions documented here provide advanced functionalities useful when #' developing within the framework implemented in the NMF package. #' #' @rdname advanced #' @name advanced-NMF NULL # declare old S3 class 'proc_time' to use it as a slot for class NMF setOldClass('proc_time', prototype=numeric()) ################################ # Class: NMF ################################ #' Generic Interface for Nonnegative Matrix Factorisation Models #' #' The class \code{NMF} is a \emph{virtual class} that defines a common #' interface to handle Nonnegative Matrix Factorization models (NMF models) #' in a generic way. #' Provided a minimum set of generic methods is implemented by concrete #' model classes, these benefit from a whole set of functions and utilities #' to perform common computations and tasks in the context of Nonnegative Matrix #' Factorization. #' #' Class \code{NMF} makes it easy to develop new models that integrate well #' into the general framework implemented by the \emph{NMF} package. #' #' Following a few simple guidelines, new types of NMF models benefit from all the #' functionalities available for the built-in NMF models -- that derive themselves #' from class \code{NMF}. #' See section \emph{Implementing NMF models} below. #' #' See \code{\linkS4class{NMFstd}}, and references and links therein for #' details on the built-in implementations of the standard NMF model and its #' extensions. #' #' @slot misc A list that is used internally to temporarily store algorithm #' parameters during the computation. #' #' @export #' @family NMF-interface #' #' @section Implementing NMF models: #' #' The class \code{NMF} only defines a basic data/low-level interface for NMF models, as #' a collection of generic methods, responsible with data handling, upon which #' relies a comprehensive set of functions, composing a rich higher-level interface. #' #' Actual NMF models are defined as sub-classes that inherits from class #' \code{NMF}, and implement the management of data storage, providing #' definitions for the interface's pure virtual methods. #' #' The minimum requirement to define a new NMF model that integrates into #' the framework of the \emph{NMF} package are the followings: #' #' \itemize{ #' #' \item Define a class that inherits from class \code{NMF} and implements the #' new model, say class \code{myNMF}. #' #' \item Implement the following S4 methods for the new class \code{myNMF}: #' \describe{ #' \item{fitted}{\code{signature(object = "myNMF", value = "matrix")}: #' Must return the estimated target matrix as fitted by the NMF model #' \code{object}. #' } #' \item{basis}{\code{signature(object = "myNMF")}: #' Must return the basis matrix(e.g. the first matrix factor in #' the standard NMF model). #' } #' \item{basis<-}{\code{signature(object = "myNMF", value = "matrix")}: #' Must return \code{object} with the basis matrix set to #' \code{value}. #' } #' \item{coef}{\code{signature(object = "myNMF")}: #' Must return the matrix of mixture coefficients (e.g. the second matrix #' factor in the standard NMF model). #' } #' \item{coef<-}{\code{signature(object = "myNMF", value = "matrix")}: #' Must return \code{object} with the matrix of mixture coefficients set to #' \code{value}. #' } #' } #' #' The \emph{NMF} package provides "pure virtual" definitions of these #' methods for class \code{NMF} (i.e. with signatures \code{(object='NMF', ...)} #' and \code{(object='NMF', value='matrix')}) that throw an error if called, so #' as to force their definition for model classes. #' #' \item Optionally, implement method \code{rnmf}(signature(x="myNMF", target="ANY")). #' This method should call \code{callNextMethod(x=x, target=target, ...)} and #' fill the returned NMF model with its specific data suitable random values. #' } #' #' For concrete examples of NMF models implementations, see class #' \code{\linkS4class{NMFstd}} and its extensions (e.g. classes #' \code{\linkS4class{NMFOffset}} or \code{\linkS4class{NMFns}}). #' #' @section Creating NMF objects: #' Strictly speaking, because class \code{NMF} is virtual, no object of class #' \code{NMF} can be instantiated, only objects from its sub-classes. #' However, those objects are sometimes shortly referred in the documentation and #' vignettes as "\code{NMF} objects" instead of "objects that inherits from #' class \code{NMF}". #' #' For built-in models or for models that inherit from the standard model class #' \code{\linkS4class{NMFstd}}, the factory method \code{nmfModel} enables to easily create #' valid \code{NMF} objects in a variety of common situations. #' See documentation for the the factory method \code{\link{nmfModel}} for #' more details. #' #' @references #' Definition of Nonnegative Matrix Factorization in its modern formulation: \cite{Lee1999} #' #' Historical first definition and algorithms: \cite{Paatero1994} #' #' @family NMF-model Implementations of NMF models #' @seealso #' Main interface to perform NMF in \code{\link{nmf-methods}}. #' #' Built-in NMF models and factory method in \code{\link{nmfModel}}. #' #' Method \code{\link{seed}} to set NMF objects with values suitable to start #' algorithms with. #' #' @examples #' #' # show all the NMF models available (i.e. the classes that inherit from class NMF) #' nmfModels() #' # show all the built-in NMF models available #' nmfModels(builtin.only=TRUE) #' #' # class NMF is a virtual class so cannot be instantiated: #' try( new('NMF') ) #' #' # To instantiate an NMF model, use the factory method nmfModel. see ?nmfModel #' nmfModel() #' nmfModel(3) #' nmfModel(3, model='NMFns') #' setClass('NMF' , representation( misc = 'list' # misceleneaous data used during fitting ) , contains = 'VIRTUAL') #' Fitted Matrix in NMF Models #' #' Computes the estimated target matrix based on a given \emph{NMF} model. #' The estimation depends on the underlying NMF model. #' For example in the standard model \eqn{V \equiv W H}{V ~ W H}, the target matrix is #' estimated by the matrix product \eqn{W H}. #' In other models, the estimate may depend on extra parameters/matrix #' (cf. Non-smooth NMF in \code{\link{NMFns-class}}). #' #' This function is a S4 generic function imported from \link[stats]{fitted} in #' the package \emph{stats}. #' It is implemented as a pure virtual method for objects of class #' \code{NMF}, meaning that concrete NMF models must provide a #' definition for their corresponding class (i.e. sub-classes of #' class \code{NMF}). #' See \code{\linkS4class{NMF}} for more details. #' #' @param object an object that inherit from class \code{NMF} #' @param ... extra arguments to allow extension #' #' @return the target matrix estimate as fitted by the model \code{object} #' @export setGeneric('fitted', package='stats') #' @template VirtualNMF setMethod('fitted', signature(object='NMF'), function(object, ...){ stop("NMF::fitted is a pure virtual method of interface 'NMF'. It should be overloaded in class '", class(object),"'.") } ) #' Accessing NMF Factors #' #' \code{basis} and \code{basis<-} are S4 generic functions which respectively #' extract and set the matrix of basis components of an NMF model #' (i.e. the first matrix factor). #' #' For example, in the case of the standard NMF model \eqn{V \equiv W H}{V ~ W H}, #' the method \code{basis} will return the matrix \eqn{W}. #' #' \code{basis} and \code{basis<-} are defined for the top #' virtual class \code{\linkS4class{NMF}} only, and rely internally on the low-level #' S4 generics \code{.basis} and \code{.basis<-} respectively that effectively #' extract/set the coefficient data. #' These data are post/pre-processed, e.g., to extract/set only their #' non-fixed terms or check dimension compatibility. #' #' @param object an object from which to extract the factor matrices, typically an #' object of class \code{\linkS4class{NMF}}. #' @param ... extra arguments to allow extension and passed to the low-level #' access functions \code{.coef} and \code{.basis}. #' #' Note that these throw an error if used in replacement functions \code{}. #' #' @rdname basis-coef-methods #' @family NMF-interface #' @export #' setGeneric('basis', function(object, ...) standardGeneric('basis') ) #' Default method returns the value of S3 slot or attribute \code{'basis'}. #' It returns \code{NULL} if none of these are set. #' #' Arguments \code{...} are not used by this method. setMethod('basis', signature(object='ANY'), function(object, ...){ if( is.list(object) && 'basis' %in% names(object) ) object[['basis']] else attr(object, 'basis') } ) #' @param all a logical that indicates whether the complete matrix factor #' should be returned (\code{TRUE}) or only the non-fixed part. #' This is relevant only for formula-based NMF models that include fixed basis or #' coefficient terms. #' #' @inline setMethod('basis', signature(object='NMF'), function(object, all=TRUE, ...){ if( all || !length(i <- ibterms(object)) ){ # return all coefficients .basis(object, ...) } else { # remove fixed basis .basis(object, ...)[, -i] } } ) #' \code{.basis} and \code{.basis<-} are the low-level S4 generics that simply #' return/set basis component data in an object. #' They are defined so that some common processing may be implemented in #' \code{basis} and \code{basis<-}. #' #' The methods \code{.basis}, \code{.coef} and their replacement versions #' are implemented as pure virtual methods for the interface class #' \code{NMF}, meaning that concrete NMF models must provide a #' definition for their corresponding class (i.e. sub-classes of #' class \code{NMF}). #' See \code{\linkS4class{NMF}} for more details. #' #' @rdname basis-coef-methods #' @export setGeneric('.basis', function(object, ...) standardGeneric('.basis') ) #' @template VirtualNMF setMethod('.basis', signature(object='NMF'), function(object, ...){ stop("NMF::.basis is a pure virtual method of interface 'NMF'. It should be overloaded in class '", class(object),"'.") } ) #' @export #' @rdname basis-coef-methods #' @inline setGeneric('basis<-', function(object, ..., value) standardGeneric('basis<-') ) #' Default methods that calls \code{.basis<-} and check the validity of the #' updated object. #' @param use.dimnames logical that indicates if the object's dim names should be #' set using those from the new value, or left unchanged -- after truncating #' them to fit new dimensions if necessary. #' This is useful to only set the entries of a factor. #' setReplaceMethod('basis', signature(object='NMF', value='ANY'), function(object, use.dimnames = TRUE, ..., value){ # error if passed extra arguments if( length(xargs<- list(...)) ){ stop("basis<-,NMF - Unused arguments: ", str_out(xargs, Inf, use.names = TRUE)) } # backup old dimnames to reapply them on exit if( !use.dimnames ) odn <- dimnames(object) nb_old <- nbasis(object) # only set non-fixed terms if( !nbterms(object) ) .basis(object) <- value else{ i <- ibasis(object) .basis(object)[,i] <- value[, i] } # adapt coef if empty if( !hasCoef(object) ){ x <- basis(object) .coef(object) <- rbind(coef(object)[1:min(nb_old, ncol(x)), , drop = FALSE], matrix(NA, max(ncol(x)-nb_old, 0), 0)) # .coef(object) <- coef(object)[1:ncol(x), , drop = FALSE] } # check object validity validObject(object) # update other factor if necessary if( use.dimnames ) basisnames(object) <- colnames(basis(object)) else if( !length(odn) ) dimnames(object) <- NULL else dimnames(object) <- mapply(head, odn, dim(object), SIMPLIFY = FALSE) object } ) #' @param value replacement value #' @rdname basis-coef-methods #' @export setGeneric('.basis<-', function(object, value) standardGeneric('.basis<-') ) #' @template VirtualNMF setReplaceMethod('.basis', signature(object='NMF', value='matrix'), function(object, value){ stop("NMF::.basis<- is a pure virtual method of interface 'NMF'. It should be overloaded in class '", class(object),"'.") } ) #' @export setGeneric('loadings', package='stats') #' Method loadings for NMF Models #' #' The method \code{loadings} is identical to \code{basis}, but do #' not accept any extra argument. #' #' The method \code{loadings} is provided to standardise the NMF interface #' against the one defined in the \code{\link{stats}} package, #' and emphasises the similarities between NMF and PCA or factorial analysis #' (see \code{\link{loadings}}). #' #' @rdname basis-coef-methods setMethod('loadings', 'NMF', function(x) basis(x) ) #' Get/Set the Coefficient Matrix in NMF Models #' #' \code{coef} and \code{coef<-} respectively extract and set the #' coefficient matrix of an NMF model (i.e. the second matrix factor). #' For example, in the case of the standard NMF model \eqn{V \equiv WH}{V ~ W H}, #' the method \code{coef} will return the matrix \eqn{H}. #' #' \code{coef} and \code{coef<-} are S4 methods defined for the corresponding #' generic functions from package \code{stats} (See \link[stats]{coef}). #' Similarly to \code{basis} and \code{basis<-}, they are defined for the top #' virtual class \code{\linkS4class{NMF}} only, and rely internally on the S4 #' generics \code{.coef} and \code{.coef<-} respectively that effectively #' extract/set the coefficient data. #' These data are post/pre-processed, e.g., to extract/set only their #' non-fixed terms or check dimension compatibility. #' #' @rdname basis-coef-methods #' @export setGeneric('coef', package='stats') #' @inline setMethod('coef', 'NMF', function(object, all=TRUE, ...){ if( all || !length(i <- icterms(object)) ){ # return all coefficients .coef(object, ...) } else { # remove fixed coefficients .coef(object, ...)[-i, ] } } ) #' \code{.coef} and \code{.coef<-} are low-level S4 generics that simply #' return/set coefficient data in an object, leaving some common processing #' to be performed in \code{coef} and \code{coef<-}. #' #' @rdname basis-coef-methods #' @export setGeneric('.coef', function(object, ...) standardGeneric('.coef')) #' @template VirtualNMF setMethod('.coef', signature(object='NMF'), function(object, ...){ stop("NMF::.coef is a pure virtual method of interface 'NMF'. It should be overloaded in class '", class(object),"'.") } ) #' @export #' @rdname basis-coef-methods #' @inline setGeneric('coef<-', function(object, ..., value) standardGeneric('coef<-') ) #' Default methods that calls \code{.coef<-} and check the validity of the #' updated object. setReplaceMethod('coef', signature(object='NMF', value='ANY'), function(object, use.dimnames = TRUE, ..., value){ # error if passed extra arguments if( length(xargs<- list(...)) ){ stop("coef<-,NMF - Unused arguments: ", str_out(xargs, Inf, use.names = TRUE)) } # backup old dimnames to reapply them on exit if( !use.dimnames ) odn <- dimnames(object) nb_old <- nbasis(object) # only set non-fixed terms if( !ncterms(object) ) .coef(object) <- value else{ i <- icoef(object) .coef(object)[i, ] <- value[i, ] } # adapt basis if empty before validation if( !hasBasis(object) ){ x <- coef(object) .basis(object) <- cbind(basis(object)[, 1:min(nb_old, nrow(x)), drop = FALSE], matrix(NA, 0, max(nrow(x)-nb_old, 0))) } # check object validity validObject(object) # update other factor if necessary if( use.dimnames ) basisnames(object) <- rownames(coef(object)) else if( !length(odn) ) dimnames(object) <- NULL else dimnames(object) <- mapply(head, odn, dim(object), SIMPLIFY = FALSE) object } ) #' @export #' @rdname basis-coef-methods setGeneric('.coef<-', function(object, value) standardGeneric('.coef<-') ) #' @template VirtualNMF setReplaceMethod('.coef', signature(object='NMF', value='matrix'), function(object, value){ stop("NMF::.coef<- is a pure virtual method of interface 'NMF'. It should be overloaded in class '", class(object),"'.") } ) #' @description Methods \code{coefficients} and \code{coefficients<-} are #' simple aliases for methods \code{coef} and \code{coef<-} respectively. #' #' @export #' @rdname basis-coef-methods setGeneric('coefficients', package='stats') #' Alias to \code{coef,NMF}, therefore also pure virtual. #' @inline setMethod('coefficients', signature(object='NMF'), selectMethod('coef', 'NMF')) #' @description \code{scoef} is similar to \code{coef}, but returns the mixture #' coefficient matrix of an NMF model, with the columns scaled so that they #' sum up to a given value (1 by default). #' #' @param scale scaling factor, which indicates to the value the columns of the #' coefficient matrix should sum up to. #' #' @rdname basis-coef-methods #' @export #' #' @examples #' #' # Scaled coefficient matrix #' x <- rnmf(3, 10, 5) #' scoef(x) #' scoef(x, 100) #' setGeneric('scoef', function(object, ...) standardGeneric('scoef') ) #' @inline setMethod('scoef', 'NMF', function(object, scale=1){ sweep(coef(object), 2L, colSums(coef(object)) / scale, '/') } ) #' @inline setMethod('scoef', 'matrix', function(object, scale=1){ sweep(object, 2L, colSums(object) / scale, '/') } ) unit.test(scoef, { x <- rnmf(3, 10, 5) checkIdentical(colSums(scoef(x)), rep(1, nbasis(x)) , "Default call: columns are scaled to sum-up to one") checkIdentical(colSums(scoef(x, 100)), rep(1, nbasis(x)) , "Scale=10: columns are scaled to sum-up to 10") }) #' Rescaling NMF Models #' #' Rescales an NMF model keeping the fitted target matrix identical. #' #' Standard NMF models are identifiable modulo a scaling factor, meaning that the #' basis components and basis profiles can be rescaled without changing the fitted #' values: #' #' \deqn{X = W_1 H_1 = (W_1 D) (D^{-1} H_1) = W_2 H_2}{X = W H = (W D) (D^-1 H)} #' with \eqn{D= \alpha diag(1/\delta_1, \ldots, 1\delta_r)}{D= alpha * diag(1/delta_1, ..., 1/delta_r)} #' #' The default call \code{scale(object)} rescales the basis NMF object so that each #' column of the basis matrix sums up to one. #' #' @param x an NMF object #' @param center either a numeric normalising vector \eqn{\delta}{delta}, or either #' \code{'basis'} or \code{'coef'}, which respectively correspond to using the #' column sums of the basis matrix or the inverse of the row sums of the #' coefficient matrix as a normalising vector. #' If numeric, \code{center} should be a single value or a vector of length the #' rank of the NMF model, i.e. the number of columns in the basis matrix. #' @param scale scaling coefficient applied to \eqn{D}, i.e. the value of \eqn{\alpha}{alpha}, #' or, if \code{center='coef'}, the value of \eqn{1/\alpha}{1/alpha} (see section \emph{Details}). #' #' @return an NMF object #' #' @S3method scale NMF #' @examples #' #' # random 3-rank 10x5 NMF model #' x <- rnmf(3, 10, 5) #' #' # rescale based on basis #' colSums(basis(x)) #' colSums(basis(scale(x))) #' #' rx <- scale(x, 'basis', 10) #' colSums(basis(rx)) #' rowSums(coef(rx)) #' #' # rescale based on coef #' rowSums(coef(x)) #' rowSums(coef(scale(x, 'coef'))) #' rx <- scale(x, 'coef', 10) #' rowSums(coef(rx)) #' colSums(basis(rx)) #' #' # fitted target matrix is identical but the factors have been rescaled #' rx <- scale(x, 'basis') #' all.equal(fitted(x), fitted(rx)) #' all.equal(basis(x), basis(rx)) #' scale.NMF <- function(x, center=c('basis', 'coef'), scale=1){ # determine base value if( missing(center) ) center <- match.arg(center) base <- center delta <- if( is.character(base) ){ base <- match.arg(center) if( base == 'basis' ) colSums(basis(x)) else{ scale <- 1/scale 1 / rowSums(coef(x)) } }else if( is.numeric(base) ) base else stop("Invalid base value: should be a numeric or one of " , str_out(c('none', 'basis', 'coef'))) # scale D <- scale/delta # W <- W * D basis(x) <- sweep(basis(x), 2L, D, '*') # H <- D^-1 * H coef(x) <- sweep(coef(x), 1L, D, '/') x } unit.test("scale", { r <- 3 x <- rnmf(r, 10, 5) .lcheck <- function(msg, rx, ref, target){ .msg <- function(...) paste(msg, ':', ...) checkTrue(!identical(basis(x), basis(rx)), .msg("changes basis matrix")) checkTrue(!identical(coef(x), coef(rx)), .msg("changes coef matrix")) checkEqualsNumeric(fitted(x), fitted(rx), .msg("fitted target is identical")) brx <- colSums(basis(rx)) crx <- rowSums(coef(rx)) if( target == 1 ){ checkEquals(brx, ref, .msg("correctly scales basis components")) checkTrue(!all(crx==ref), .msg("does not force scale on coefficient matrix")) }else{ checkTrue(!all(brx==ref), .msg("does not force scale on basis matrix")) checkEquals(crx, ref , .msg("correctly scales rows of coef matrix")) } } .check <- function(msg, ref, ...){ .lcheck(str_c(msg, " + argument center='basis'") , scale(x, center='basis', ...), ref, 1) .lcheck(str_c(msg, " + argument center='coef'") , scale(x, center='coef', ...), ref, 2) } .lcheck("Default call", scale(x), rep(1, r), 1) .check("Missing argument scale", rep(1, r)) .check("Argument scale=10", rep(10, r), scale=10) s <- runif(r) .check("Argument scale=numeric", s, scale=s) }) #' Generating Random NMF Models #' #' Generates NMF models with random values drawn from a uniform distribution. #' It returns an NMF model with basis and mixture coefficient matrices filled #' with random values. #' The main purpose of the function \code{rnmf} is to provide a common #' interface to generate random seeds used by the \code{\link{nmf}} function. #' #' If necessary, extensions of the standard NMF model or custom models must #' define a method "rnmf,,numeric" for initialising their #' specific slots other than the basis and mixture coefficient matrices. #' In order to benefit from the complete built-in interface, the overloading #' methods should call the generic version using function #' \code{\link{callNextMethod}}, prior to set the values of the specific slots. #' See for example the method \code{\link[=rnmf,NMFOffset,numeric-method]{rnmf}} #' defined for \code{\linkS4class{NMFOffset}} models: #' \code{showMethods(rnmf, class='NMFOffset', include=TRUE))}. #' #' For convenience, shortcut methods for working on \code{data.frame} objects #' directly are implemented. #' However, note that conversion of a \code{data.frame} into a \code{matrix} #' object may take some non-negligible time, for large datasets. #' If using this method or other NMF-related methods several times, consider #' converting your data \code{data.frame} object into a matrix once for good, #' when first loaded. #' #' @param x an object that determines the rank, dimension and/or class of the #' generated NMF model, e.g. a numeric value or an object that inherits from class #' \code{\linkS4class{NMF}}. #' See the description of the specific methods for more details on the supported #' types. #' @param target optional specification of target dimensions. #' See section \emph{Methods} for how this parameter is used by the different #' methods. #' @param ... extra arguments to allow extensions and passed to the next method #' eventually down to \code{\link{nmfModel}}, where they are used to initialise #' slots that are specific to the instantiating NMF model. #' #' @return An NMF model, i.e. an object that inherits from class #' \code{\linkS4class{NMF}}. #' #' @inline #' @export #' @seealso \code{\link{rmatrix}} #' @family NMF-interface setGeneric('rnmf', function(x, target, ...) standardGeneric('rnmf') ) # Define the loading namespace .PKG.NAMESPACE <- packageEnv() #' Testing NMF Objects #' #' @description #' The functions documented here tests different characteristics of NMF objects. #' #' \code{is.nmf} tests if an object is an NMF model or a class that extends #' the class NMF. #' #' @details #' #' \code{is.nmf} tests if \code{object} is the name of a class (if a \code{character} #' string), or inherits from a class, that extends \code{\linkS4class{NMF}}. #' #' @note The function \code{is.nmf} does some extra work with the namespace as #' this function needs to return correct results even when called in \code{.onLoad}. #' See discussion on r-devel: \url{https://stat.ethz.ch/pipermail/r-devel/2011-June/061357.html} #' #' @param x an R object. See section \emph{Details}, for how each function #' uses this argument. #' #' @rdname types #' @export #' #' @examples #' #' # test if an object is an NMF model, i.e. that it implements the NMF interface #' is.nmf(1:4) #' is.nmf('NMFstd') #' is.nmf('NMFblah') #' is.nmf( nmfModel(3) ) #' is.nmf( nmf(rmatrix(20,10), 3) ) #' is.nmf <- function(x){ # load definition for base class NMF clref <- getClass('NMF', .Force=TRUE, where=.PKG.NAMESPACE) is(x, clref) } unit.test(is.nmf,{ checkTrue(!is.nmf(1:4), "on vector: FALSE") checkTrue(!is.nmf(list(1:4)), "on list: FALSE") checkTrue(is.nmf('NMF'), "on 'NMF': TRUE") checkTrue(is.nmf('NMFstd'), "on 'NMFstd': TRUE") checkTrue( is.nmf( nmfModel(3) ), "on empty model: TRUE") checkTrue( is.nmf( rnmf(3, 20, 10) ), "on random model: TRUE") checkTrue( is.nmf( nmf(rmatrix(20,10), 3) ), "on NMFfit object: TRUE") }) isNMFclass <- function(x){ if( is.character(x) ){ # test object is a class that extends NMF # load definition for base class NMF clref <- getClass('NMF', .Force=TRUE, where=.PKG.NAMESPACE) cl <- getClass(x, .Force=TRUE, where=.PKG.NAMESPACE) if( is.null(cl) ) cl <- getClass(x, .Force=TRUE) extends(cl, clref) }else FALSE } ################################ # Taken from Biobase selectSome <- function (obj, maxToShow = 5) { len <- length(obj) if (maxToShow < 3) maxToShow <- 3 if (len > maxToShow) { maxToShow <- maxToShow - 1 bot <- ceiling(maxToShow/2) top <- len - (maxToShow - bot - 1) nms <- obj[c(1:bot, top:len)] c(as.character(nms[1:bot]), "...", as.character(nms[-c(1:bot)])) } else if (is.factor(obj)) as.character(obj) else obj } .showFixedTerms <- function(x, ...){ s <- sapply(x, function(t){ s <- if( is.factor(t) ) selectSome(levels(t), ...) else selectSome(t, ...) s <- str_out(s, Inf, quote=FALSE) if( is.factor(t) ) s <- str_c('<', s, ">") s }) paste(names(s), '=', s) } #' Show method for objects of class \code{NMF} #' @export setMethod('show', 'NMF', function(object) { cat("\n", sep='') cat("features:", nrow(object), "\n") cat("basis/rank:", nbasis(object), "\n") cat("samples:", ncol(object), "\n") # show fixed terms if( (n <- ncterms(object)) ){ cat("fixed coef [", n, "]:\n" , str_c(' ', .showFixedTerms(cterms(object), 4), collapse="\n") , "\n", sep='') } if( (n <- nbterms(object)) ){ cat("fixed basis [", n, "]:\n" , str_c(' ', .showFixedTerms(bterms(object), 4), collapse="\n") , "\n", sep='') } # show the miscellaneous model parameters if( length(object@misc) > 0L ){ cat("miscellaneous:", str_desc(object@misc, exdent=12L), ". (use 'misc(object)')\n") } } ) #' Dimension of NMF Objects #' #' @description #' The methods \code{dim}, \code{nrow}, \code{ncol} and \code{nbasis} return #' the different dimensions associated with an NMF model. #' #' \code{dim} returns all dimensions in a length-3 integer vector: #' the number of row and columns of the estimated target matrix, #' as well as the factorization rank (i.e. the number of basis components). #' #' \code{nrow}, \code{ncol} and \code{nbasis} provide separate access to each #' of these dimensions respectively. #' #' @details #' The NMF package does not implement specific functions \code{nrow} and \code{ncol}, #' but rather the S4 method \code{dim} for objects of class \code{\linkS4class{NMF}}. #' This allows the base methods \code{\link{nrow}} and \code{\link{ncol}} to #' directly work with such objects, to get the number of rows and columns of #' the target matrix estimated by an NMF model. #' #' The function \code{nbasis} is a new S4 generic defined in the package NMF, that #' returns the number of basis components of an object. #' Its default method should work for any object, that has a suitable #' \code{basis} method defined for its class. #' #' @param x an object with suitable \code{basis} and \code{coef} methods, such #' as an object that inherit from \code{\linkS4class{NMF}}. #' @param ... extra arguments to allow extension. #' #' @return a single integer value or, for \code{dim}, a length-3 integer vector, #' e.g. \code{c(2000, 30, 3)} for an \code{NMF} model that fits a 2000 x 30 #' matrix using 3 basis components. #' #' @export #' @rdname dims #' @aliases dim-NMF setGeneric('nbasis', function(x, ...) standardGeneric('nbasis') ) #' Default method which returns the number of columns of the basis matrix extracted #' from \code{x} using a suitable method \code{basis}, or, if the latter is \code{NULL}, #' the value of attributes \code{'nbasis'}. #' #' For NMF models, this also corresponds to the number of rows in the coefficient #' matrix. #' setMethod('nbasis', signature(x='ANY'), function(x, ...) { if( !is.null(n <- ncol(basis(x, ...))) ) n else if( is.list(x) && 'nbasis' %in% names(x) ) x[['nbasis']] else attr(x, 'nbasis') } ) #' method for NMF objects for the base generic \code{\link{dim}}. #' It returns all dimensions in a length-3 integer vector: #' the number of row and columns of the estimated target matrix, #' as well as the factorization rank (i.e. the number of basis components). #' #' @rdname dims #' @export setMethod('dim', signature(x='NMF'), function(x){ c(nrow(basis(x)), ncol(coef(x)), nbasis(x)) } ) #' Dimension names for NMF objects #' #' @description #' The methods \code{dimnames}, \code{rownames}, \code{colnames} and #' \code{basisnames} and their respective replacement form allow to get and set #' the dimension names of the matrix factors in a NMF model. #' #' \code{dimnames} returns all the dimension names in a single list. #' Its replacement form \code{dimnames<-} allows to set all dimension names at once. #' #' \code{rownames}, \code{colnames} and \code{basisnames} provide separate access #' to each of these dimension names respectively. #' Their respective replacement form allow to set each dimension names separately. #' #' @details #' #' The function \code{basisnames} is a new S4 generic defined in the package NMF, #' that returns the names of the basis components of an object. #' Its default method should work for any object, that has a suitable \code{basis} #' method defined for its class. #' #' The method \code{dimnames} is implemented for the base generic \code{\link{dimnames}}, #' which make the base function \code{\link{rownames}} and \code{\link{colnames}} #' work directly. #' #' Overall, these methods behave as their equivalent on \code{matrix} objects. #' The function \code{basisnames<-} ensures that the dimension names are handled #' in a consistent way on both factors, enforcing the names on both matrix factors #' simultaneously. #' #' @param x an object with suitable \code{basis} and \code{coef} methods, such #' as an object that inherit from \code{\linkS4class{NMF}}. #' @param ... extra argument to allow extension. #' #' @export #' @rdname dimnames #' @aliases dimnames-NMF #' #' @examples #' # create a random NMF object #' a <- rnmf(2, 5, 3) #' #' # set dimensions #' dims <- list( features=paste('f', 1:nrow(a), sep='') #' , samples=paste('s', 1:ncol(a), sep='') #' , basis=paste('b', 1:nbasis(a), sep='') ) #' dimnames(a) <- dims #' dimnames(a) #' basis(a) #' coef(a) #' #' # access the dimensions separately #' rownames(a) #' colnames(a) #' basisnames(a) #' #' # set only the first dimension (rows of basis): the other two dimnames are set to NULL #' dimnames(a) <- dims[1] #' dimnames(a) #' basis(a) #' coef(a) #' #' # set only the two first dimensions (rows and columns of basis and coef respectively): #' # the basisnames are set to NULL #' dimnames(a) <- dims[1:2] #' dimnames(a) #' basis(a) #' #' # reset the dimensions #' dimnames(a) <- NULL #' dimnames(a) #' basis(a) #' coef(a) #' #' # set each dimensions separately #' rownames(a) <- paste('X', 1:nrow(a), sep='') # only affect rows of basis #' basis(a) #' #' colnames(a) <- paste('Y', 1:ncol(a), sep='') # only affect columns of coef #' coef(a) #' #' basisnames(a) <- paste('Z', 1:nbasis(a), sep='') # affect both basis and coef matrices #' basis(a) #' coef(a) #' setGeneric('basisnames', function(x, ...) standardGeneric('basisnames') ) #' Default method which returns the column names of the basis matrix extracted from #' \code{x}, using the \code{basis} method. #' #' For NMF objects these also correspond to the row names of the coefficient matrix. setMethod('basisnames', signature(x='ANY'), function(x) { colnames(basis(x)) } ) #' The generic \code{basisnames<-} simultaneously sets the names of the basis #' components and coefficients of an object, for which suitable \code{basis} #' and \code{coef} methods are defined. #' #' @details #' The function \code{basisnames<-} is a new S4 generic defined in the package NMF, #' that sets the names of the basis components of an object. #' Its default method should work for any object, that has suitable \code{basis<-} #' and \code{coef<-} methods method defined for its class. #' #' @export #' @inline #' @rdname dimnames setGeneric('basisnames<-', function(x, ..., value) standardGeneric('basisnames<-') ) #' Default method which sets, respectively, the row and the column names of the basis #' matrix and coefficient matrix of \code{x} to \code{value}. setReplaceMethod('basisnames', 'ANY', function(x, ..., value) { rownames(.coef(x)) <- value colnames(.basis(x)) <- value x } ) #' Returns the dimension names of the NMF model \code{x}. #' #' It returns either NULL if no dimnames are set on the object, #' or a 3-length list containing the row names of the basis matrix, #' the column names of the mixture coefficient matrix, and the column names of #' the basis matrix (i.e. the names of the basis components). #' #' @param value a character vector, or \code{NULL} or, in the case of #' \code{dimnames<-}, a list 2 or 3-length list of character vectors. #' #' @rdname dimnames #' @export setMethod('dimnames', 'NMF', function(x){ b <- dimnames(basis(x)) if( is.null(b) ) b <- list(NULL, NULL) c <- dimnames(coef(x)) if( is.null(c) ) c <- list(NULL, NULL) l <- c(b[1],c[2],b[2]) if( all(sapply(l, is.null)) ) NULL else l } ) #' sets the dimension names of the NMF model \code{x}. #' #' \code{value} can be \code{NULL} which resets all dimension names, or a #' 1, 2 or 3-length list providing names at least for the rows of the basis #' matrix. #' #' The optional second element of \code{value} (NULL if absent) is used to set #' the column names of the coefficient matrix. #' The optional third element of \code{value} (NULL if absent) is used to set #' both the column names of the basis matrix and the row names of the #' coefficient matrix. #' #' @rdname dimnames #' @export setReplaceMethod('dimnames', 'NMF', function(x, value){ if( !is.list(value) && !is.null(value) ) stop("NMF::dimnames - Invalid value: must be a list or NULL.") if( length(value) == 0 ) value <- NULL else if( length(value) == 1 ) value <- c(value, list(NULL, NULL)) else if( length(value) == 2 ) # if only the two first dimensions reset the third one value <- c(value, list(NULL)) else if( length(value)!=3 ) # check length of value stop("NMF::dimnames - invalid argument 'value' [a 2 or 3-length list is expected]") # only set relevant dimensions if( length(w <- which(dim(x) == 0)) ){ value[w] <- sapply(value[w], function(x) NULL, simplify=FALSE) } # set dimnames dimnames(.basis(x)) <- value[c(1,3)] dimnames(.coef(x)) <- value[c(3,2)] # return updated model x } ) #' Sub-setting NMF Objects #' #' This method provides a convenient way of sub-setting objects of class \code{NMF}, #' using a matrix-like syntax. #' #' It allows to consistently subset one or both matrix factors in the NMF model, as well #' as retrieving part of the basis components or part of the mixture coefficients with #' a reduced amount of code. #' #' @details #' The returned value depends on the number of subset index passed and the #' value of argument \code{drop}: #' #' \itemize{ \item No index as in \code{x[]} or \code{x[,]}: the value is the #' object \code{x} unchanged. #' #' \item One single index as in \code{x[i]}: the value is the complete NMF #' model composed of the selected basis components, subset by \code{i}, #' except if argument \code{drop=TRUE}, or if it is missing and \code{i} is of length 1. #' Then only the basis matrix is returned with dropped dimensions: #' \code{x[i, drop=TRUE]} <=> \code{drop(basis(x)[, i])}. #' #' This means for example that \code{x[1L]} is the first basis vector, #' and \code{x[1:3, drop = TRUE]} is the matrix composed of the 3 first basis vectors -- in columns. #' #' Note that in version <= 0.18.3, the call \code{x[i, drop = TRUE.or.FALSE]} was equivalent to #' \code{basis(x)[, i, drop=TRUE.or.FALSE]}. #' #' \item More than one index with \code{drop=FALSE} (default) as in #' \code{x[i,j]}, \code{x[i,]}, \code{x[,j]}, \code{x[i,j,k]}, \code{x[i,,k]}, #' etc...: the value is a \code{NMF} object whose basis and/or mixture #' coefficient matrices have been subset accordingly. The third index \code{k} #' affects simultaneously the columns of the basis matrix AND the rows of the #' mixture coefficient matrix. In this case argument \code{drop} is not used. #' #' \item More than one index with \code{drop=TRUE} and \code{i} xor \code{j} #' missing: the value returned is the matrix that is the more affected by the #' subset index. That is that \code{x[i, , drop=TRUE]} and \code{x[i, , k, #' drop=TRUE]} return the basis matrix subset by \code{[i,]} and \code{[i,k]} #' respectively, while \code{x[, j, drop=TRUE]} and \code{x[, j, k, drop=TRUE]} #' return the mixture coefficient matrix subset by \code{[,j]} and \code{[k,j]} #' respectively. #' #' } #' #' @param i index used to subset on the \strong{rows} of the basis matrix (i.e. #' the features). #' It can be a \code{numeric}, \code{logical}, or \code{character} vector #' (whose elements must match the row names of \code{x}). #' In the case of a \code{logical} vector the entries are recycled if necessary. #' @param j index used to subset on the \strong{columns} of the mixture #' coefficient matrix (i.e. the samples). #' It can be a \code{numeric}, \code{logical}, or \code{character} vector #' (whose elements must match the column names of \code{x}). #' In the case of a \code{logical} vector the entries are recycled if necessary. #' @param ... used to specify a third index to subset on the basis components, #' i.e. on both the columns and rows of the basis matrix and mixture #' coefficient respectively. #' It can be a \code{numeric}, \code{logical}, or \code{character} vector #' (whose elements must match the basis names of \code{x}). #' In the case of a \code{logical} vector the entries are recycled if necessary. #' #' Note that only the first extra subset index is used. #' A warning is thrown if more than one extra argument is passed in \code{...}. #' @param drop single \code{logical} value used to drop the \code{NMF-class} #' wrapping and only return subsets of one of the factor matrices (see \emph{Details}) #' #' @rdname subset-NMF #' @export #' @examples #' # create a dummy NMF object that highlight the different way of subsetting #' a <- nmfModel(W=outer(seq(1,5),10^(0:2)), H=outer(10^(0:2),seq(-1,-10))) #' basisnames(a) <- paste('b', 1:nbasis(a), sep='') #' rownames(a) <- paste('f', 1:nrow(a), sep='') #' colnames(a) <- paste('s', 1:ncol(a), sep='') #' #' # or alternatively: #' # dimnames(a) <- list( features=paste('f', 1:nrow(a), sep='') #' # , samples=paste('s', 1:ncol(a), sep='') #' # , basis=paste('b', 1:nbasis(a)) ) #' #' # look at the resulting NMF object #' a #' basis(a) #' coef(a) #' #' # extract basis components #' a[1] #' a[1, drop=FALSE] # not dropping matrix dimension #' a[2:3] #' #' # subset on the features #' a[1,] #' a[2:4,] #' # dropping the NMF-class wrapping => return subset basis matrix #' a[2:4,, drop=TRUE] #' #' # subset on the samples #' a[,1] #' a[,2:4] #' # dropping the NMF-class wrapping => return subset coef matrix #' a[,2:4, drop=TRUE] #' #' # subset on the basis => subsets simultaneously basis and coef matrix #' a[,,1] #' a[,,2:3] #' a[4:5,,2:3] #' a[4:5,,2:3, drop=TRUE] # return subset basis matrix #' a[,4:5,2:3, drop=TRUE] # return subset coef matrix #' #' # 'drop' has no effect here #' a[,,2:3, drop=TRUE] #' setMethod('[', 'NMF', function (x, i, j, ..., drop = FALSE) { k <- NULL mdrop <- missing(drop) # compute number of arguments: x and drop are always passed Nargs <- nargs() - !mdrop single.arg <- FALSE k.notmissing <- FALSE if( !missing(i) && Nargs < 3L ){ k <- i single.arg <- TRUE } else if( Nargs > 3L ){ dots <- list(...) if( length(dots) != 1 ) warning("NMF::[ - using only the first extra subset index, the remaining ", length(dots)-1," are discarded.") k <- dots[[1]] k.notmissing <- TRUE } # no indice was provided => return the object unchanged if ( missing(i) && missing(j) && !k.notmissing ) { # check if there is other arguments if (length(list(...)) != 0) stop("NMF::[] method - please specify which features, samples or basis to subset. See class?NMF.") # otherwise return the untouched object return(x) } # subset the rows of the basis matrix if ( !missing(i) && !single.arg ) .basis(x) <- basis(x)[i, , drop = FALSE] # subset the columns of mixture coefficient matrix if (!missing(j)) .coef(x) <- coef(x)[, j, drop = FALSE] # subset the basis: columns of basis matrix and row of mixture coefficient matrix if( single.arg || k.notmissing ){ .basis(x) <- basis(x)[, k, drop = FALSE] # return basis only single arg and drop=TRUE if( single.arg && ((mdrop && length(k) == 1L) || drop) ) return( drop(basis(x)) ) .coef(x) <- coef(x)[k, , drop = FALSE] } # if drop is TRUE and only one dimension is missing then return affected matrix if( !single.arg && drop ){ if( missing(i) && !missing(j) ) return( drop(coef(x)) ) else if( missing(j) && !missing(i) ) return( drop(basis(x)) ) } # return subset object return(x) } ) #' The function \code{misc} provides access to miscellaneous data members stored #' in slot \code{misc} (as a \code{list}), which allow extensions of NMF models #' to be implemented, without defining a new S4 class. #' #' @param object an object that inherit from class \code{NMF} #' @param ... extra arguments (not used) #' #' @rdname NMF-class #' @export misc <- function(object, ...){ if( !isS4(object) && is.list(object) ) object[['misc']] else attr(object, 'misc') } #' shortcut for \code{x@@misc[[name, exact=TRUE]]} respectively. #' @rdname NMF-class #' @export setMethod('$', 'NMF', function(x, name){ x@misc[[name, exact=TRUE]]; } ) #' shortcut for \code{x@@misc[[name]] <- value} #' @rdname NMF-class #' @export setReplaceMethod('$', 'NMF', function(x, name, value) { x@misc[[name]] <- value x } ) #' @importFrom utils .DollarNames setGeneric('.DollarNames', package='utils') #' @S3method .DollarNames NMF .DollarNames.NMF <- function(x, pattern = "") grep(pattern, names(misc(x)), value=TRUE) #' Auto-completion for \code{\linkS4class{NMF}} objects #' @rdname NMF-class #' @export setMethod('.DollarNames', 'NMF', .DollarNames.NMF) #' \code{is.empty.nmf} tests whether an \code{NMF} object describes an empty NMF model, #' i.e. it contains no data. #' #' @details #' \code{is.empty.nmf} returns \code{TRUE} if the basis and coefficient matrices of #' \code{x} have respectively zero rows and zero columns. #' It returns \code{FALSE} otherwise. #' #' In particular, this means that an empty model can still have a non-zero number #' of basis components, i.e. a factorization rank that is not null. #' This happens, for example, in the case of NMF models created calling the factory method #' \code{\link{nmfModel}} with a value only for the factorization rank. #' #' @param ... extra parameters to allow extension or passed to subsequent calls #' #' @rdname types #' @export #' #' @examples #' #' # empty model #' is.empty.nmf( nmfModel(3) ) #' # non empty models #' is.empty.nmf( nmfModel(3, 10, 0) ) #' is.empty.nmf( rnmf(3, 10, 5) ) #' is.empty.nmf <- function(x, ...){ nrow(x) == 0 && ncol(x) == 0 } #' \code{hasBasis} tests whether an objects contains a basis matrix -- returned by #' a suitable method \code{basis} -- with at least one row. #' #' @rdname types #' @export hasBasis <- function(x) nbasis(x) && nrow(basis(x)) != 0L #' \code{hasBasis} tests whether an objects contains a coefficient matrix #' -- returned by a suitable method \code{coef} -- with at least one column. #' #' @rdname types #' @export hasCoef <- function(x) nbasis(x) && ncol(coef(x)) != 0L #' \code{is.partial.nmf} tests whether an NMF model object contains either an empty #' basis or coefficient matrix. #' It is a shorcut for \code{!hasCoef(x) || !hasBasis(x)}. #' #' @rdname types #' @export is.partial.nmf <- function(x) !hasCoef(x) || !hasBasis(x) #' Returns the target matrix estimate of the NMF model \code{x}, perturbated by #' adding a random matrix generated using the default method of \code{rmatrix}: #' it is a equivalent to \code{fitted(x) + rmatrix(fitted(x), ...)}. #' #' This method can be used to generate random target matrices that depart from #' a known NMF model to a controlled extend. #' This is useful to test the robustness of NMF algorithms to the presence of #' certain types of noise in the data. #' #' @examples #' # generate noisy fitted target from an NMF model (the true model) #' gr <- as.numeric(mapply(rep, 1:3, 3)) #' h <- outer(1:3, gr, '==') + 0 #' x <- rnmf(10, H=h) #' y <- rmatrix(x) #' \dontrun{ #' # show heatmap of the noisy target matrix: block patterns should be clear #' aheatmap(y) #' } #' \dontshow{ stopifnot( identical(dim(y), dim(x)[1:2]) ) } #' #' # test NMF algorithm on noisy data #' # add some noise to the true model (drawn from uniform [0,1]) #' res <- nmf(rmatrix(x), 3) #' summary(res) #' #' # add more noise to the true model (drawn from uniform [0,10]) #' res <- nmf(rmatrix(x, max=10), 3) #' summary(res) #' setMethod('rmatrix', 'NMF', function(x, ...){ a <- fitted(x) a + rmatrix(a, ...) } ) unit.test('rmatrix,NMF',{ x <- nmfModel(3, 20, 5) checTrue(is.matrix(y <- rmatrix(x)), "default call: no error") checkIdentical(dim(y), dim(x)[1:2], "default call: correct dimension") checkTrue( !any(is.na(basis(y))), 'default call: no NAs in basis anymore') checkTrue( !any(is.na(coef(y))), 'default call: no NAs in coef anymore') checkTrue( max( max(abs(basis(y)-basis(x))), max(abs(coef(y)-coef(x))) ) <= 1 , "default call: max difference is <= 1") set.seed(123) y <- rmatrix(x) set.seed(123) ref <- matrix(runif(nrow(x)*ncol(x)), nrow(x)) checkIdentical(ref, y - fitted(x), "default call: add uniform random noise to fitted matrix") set.seed(123) ref <- matrix(rnorm(nrow(x)*ncol(x)), nrow(x)) set.seed(123) y <- rmatrix(x, rnorm) checkIdentical(ref, y - fitted(x), "dist is taken into account: add normal random noise to fitted matrix") set.seed(123) y <- rmatrix(x, dist=rnorm) checkIdentical(ref, y - fitted(x), "dist is taken into account: add normal random noise to fitted matrix") set.seed(123) checTrue(is.matrix(y <- rmatrix(x, max=10)), "call with arg max=10: no error") checkTrue( max( max(abs(basis(y)-basis(x))), max(abs(coef(y)-coef(x))) ) <= 10 , "call with arg max=10: max difference is 10") checkTrue( max( max(abs(basis(y)-basis(x))), max(abs(coef(y)-coef(x))) ) >= 5 , "call with arg max=10: max difference is >= 5") }) ###% Produces different kind of plots. #setGeneric('plot', package='graphics') #setMethod('plot', signature( x='NMF', y='missing'), # function(x, y, type=c('hist', 'heatmap'), ...) # { # # retrieve what to plot # type = match.arg(type) # # # save graphical parameters # oldpar = par(no.readonly=TRUE) # on.exit( {par(oldpar)} ) # reset the graphical parameters on exit # # if( what == 'heatmap' ){ # #basicHM(metaprofiles(x), ...) # heatmap.2(metaprofiles(x), trace='none', ...) # } # else if( what == 'hist' ) hist(x, ...) # # } #) #setGeneric('hist', package='graphics') #setMethod('hist', signature(x='NMF'), # function(x, ref=1, alpha=20, ...) # { # stopifnot( ref >= 1 && ref <= ncol(metagenes(x)) ) # alpha = sprintf("%02d", alpha) #add leading zero to alpha if nessecary # # # save graphical parameters # oldpar = par(no.readonly=TRUE) # on.exit( {par(oldpar)} ) # reset the graphical parameters on exit # # # order genes by decreasing contribution to the reference factor # M = metagenes(x)[order(metagenes(x)[,ref], decreasing=T), ] # # #plot the contributions to the reference factor # par(lwd = 0.5) # x = seq(nrow(M)) # html.colors = apply( col2rgb( seq(ncol(M))+1 ), 2, function(x) paste("#", paste(intToHex(x), collapse=''), alpha, sep='') ) # plot(x=x, y=M[,ref], type='h' # , col=html.colors[ref], ylim=c(min(M), max(M)) # , main='Contribution to metagenes', xlab=paste('Genes ordered based on factor', ref), ylab='Contribution') # # # plot the remaining metagenes # remaining.factor = seq(ncol(M))[seq(ncol(M)) != ref] # sapply(remaining.factor, # function(f){ # lines(x=x, M[,f], type='h', col=html.colors[f]) # } # ) # # #put the legend # legend('top', legend=paste('Factor', seq(ncol(M))), fill=sub("^(#[a-f0-9]{6}).*", "\\1", html.colors, ignore.case=TRUE) ) # # invisible() # } #) ###% Utility function used to sets default elements in a list if they are ###% not already set ###% The default values are given in argument ... .set.list.defaults <- function(input.list, ...){ expand_list(input.list, ..., .exact=FALSE) } ###% Partially match arguments for a given function .match.call.args <- function(x, fun, in.fun=NULL, call=NULL){ stopifnot( is.character(fun) && length(fun) == 1 ) if( length(x) == 0 ) return(x) x.ind <- charmatch(x, args <- formalArgs(getFunction(fun))) sapply(seq(length(x)), function(i){ ind <- x.ind[i] # the argument is not part of the call: keep it unchanged if( is.na(ind) ) return(x[i]) # multiple matches: error if( ind == 0 ){ alt <- paste(grep(paste('^', x[i], sep=''), args, value=TRUE), collapse=', ') stop(if( !is.null(call) ) c(call, ' - '), "Multiple match for argument '", x[i], "' of function '" , if( is.null(in.fun) ) fun else in.fun, "' [use one of: ", alt, "]" , call.=FALSE) } # return the matched full names args[ind] }) } ###% Computes a set of measures usefull to assess the factorization's quality. ###% ###% ###% @param object a \code{NMF} object ###% @return a numeric vector of the measures. ###% #' Assessing and Comparing NMF Models #' #' @description #' The NMF package defines \code{summary} methods for different classes of objects, #' which helps assessing and comparing the quality of NMF models by computing a set #' of quantitative measures, e.g. with respect to their ability to recover known #' classes and/or the original target matrix. #' #' The most useful methods are for classes \code{\linkS4class{NMF}}, \code{\linkS4class{NMFfit}}, #' \code{\linkS4class{NMFfitX}} and \code{\linkS4class{NMFList}}, which compute summary measures #' for, respectively, a single NMF model, a single fit, a multiple-run fit and a list of heterogenous #' fits performed with the function \code{\link{nmf}}. #' #' @details #' Due to the somehow hierarchical structure of the classes mentionned in \emph{Description}, #' their respective \code{summary} methods call each other in chain, each super-class adding some #' extra measures, only relevant for objects of a specific class. #' #' @param object an NMF object. See available methods in section \emph{Methods}. #' @param ... extra arguments passed to the next \code{summary} method. #' #' @export #' @rdname assess #' @aliases summary-NMF #' #' @family assess Assessment measures for NMF models #' setGeneric('summary', package='base') #' Computes summary measures for a single NMF model. #' #' The following measures are computed: #' #' \describe{ #' \item{sparseness}{Sparseness of the factorization computed by the #' function \code{\link{sparseness}}.} #' \item{entropy}{Purity of the clustering, with respect to known classes, #' computed by the function \code{\link{purity}}.} #' \item{entropy}{Entropy of the clustering, with respect to known classes, #' computed by the function \code{\link{entropy}}.} #' \item{RSS}{Residual Sum of Squares computed by the function \code{\link{rss}}.} #' \item{evar}{Explained variance computed by the function \code{\link{evar}}.} #' } #' #' @param class known classes/cluster of samples specified in one of the formats #' that is supported by the functions \code{\link{entropy}} and \code{\link{purity}}. #' @param target target matrix specified in one of the formats supported by the #' functions \code{\link{rss}} and \code{\link{evar}} #' #' @rdname assess #' #' @examples #' #' # random NMF model #' x <- rnmf(3, 20, 12) #' summary(x) #' summary(x, gl(3, 4)) #' summary(x, target=rmatrix(x)) #' summary(x, gl(3,4), target=rmatrix(x)) #' setMethod('summary', signature(object='NMF'), function(object, class, target){ res <- numeric() ## IMPORTANT: if adding a summary measure also add it in the sorting ## schema of method NMFList::summary to allow ordering on it # rank res <- c(res, rank=nbasis(object)) # compute sparseness res <- c(res, sparseness=sparseness(object)) # if class is provided: also computes entropy and purity if( !missing(class) ){ # compute purity res <- c(res, purity=purity(object, class)) # compute entropy res <- c(res, entropy=entropy(object, class)) } # if the target is provided compute the RSS if( !missing(target) ){ RSS <- rss(object, target) res <- c(res, rss=RSS) # explained variance res <- c(res, evar=evar(object, target)) } # compute mean silhouette width siS <- silhouette(object, what = 'samples') siF <- silhouette(object, what = 'features') res <- c(res, silhouette.coef = if( !is_NA(siS) ) summary(siS)$avg.width else NA , silhouette.basis = if( !is_NA(siF) ) summary(siF)$avg.width else NA) # return result return(res) } ) #' Sparseness #' #' Generic function that computes the \emph{sparseness} of an object, as defined #' by \cite{Hoyer2004}. #' The sparseness quantifies how much energy of a vector is packed into only few components. #' #' In \cite{Hoyer2004}, the sparseness is defined for a real vector \eqn{x} as: #' \deqn{Sparseness(x) = \frac{\sqrt{n} - \frac{\sum |x_i|}{\sqrt{\sum x_i^2}}}{\sqrt{n}-1}}{ #' (srqt(n) - ||x||_1 / ||x||_2) / (sqrt(n) - 1)} #' #' , where \eqn{n} is the length of \eqn{x}. #' #' The sparseness is a real number in \eqn{[0,1]}. #' It is equal to 1 if and only if \code{x} contains a single nonzero component, #' and is equal to 0 if and only if all components of \code{x} are equal. #' It interpolates smoothly between these two extreme values. #' The closer to 1 is the sparseness the sparser is the vector. #' #' The basic definition is for a \code{numeric} vector, and is extended for matrices as the #' mean sparseness of its column vectors. #' #' @param x an object whose sparseness is computed. #' @param ... extra arguments to allow extension #' #' @return usually a single numeric value -- in [0,1], or a numeric vector. #' See each method for more details. #' #' @export #' @family assess setGeneric('sparseness', function(x, ...) standardGeneric('sparseness') ) #' Base method that computes the sparseness of a numeric vector. #' #' It returns a single numeric value, computed following the definition #' given in section \emph{Description}. setMethod('sparseness', signature(x='numeric'), function(x){ # get length of x n <- length(x) # compute and return the sparseness ( sqrt(n) - sum(abs(x)) / sqrt(sum(x^2)) ) / (sqrt(n)-1) } ) #' Computes the sparseness of a matrix as the mean sparseness of its column vectors. #' It returns a single numeric value. setMethod('sparseness', signature(x='matrix'), function(x){ # compute the sparseness of each column s <- apply(x, 2, sparseness) # return the mean sparseness mean(s) } ) #' Compute the sparseness of an object of class \code{NMF}, as the sparseness of #' the basis and coefficient matrices computed separately. #' #' It returns the two values in a numeric vector with names \sQuote{basis} and \sQuote{coef}. setMethod('sparseness', signature(x='NMF'), function(x){ # return the sparseness of the basis and coef matrix c(basis=sparseness(basis(x)), coef=sparseness(coef(x))) } ) #' Purity and Entropy of a Clustering #' #' The functions \code{purity} and \code{entropy} respectively compute the purity and the entropy #' of a clustering given \emph{a priori} known classes. #' #' The purity and entropy measure the ability of a clustering method, to recover #' known classes (e.g. one knows the true class labels of each sample), that are #' applicable even when the number of cluster is different from the number of known classes. #' \cite{KimH2007} used these measures to evaluate the performance of their alternate least-squares #' NMF algorithm. #' #' @details #' Suppose we are given \eqn{l} categories, while the clustering method generates #' \eqn{k} clusters. #' #' The purity of the clustering with respect to the known categories is given by: #' \deqn{Purity = \frac{1}{n} \sum_{q=1}^k \max_{1 \leq j \leq l} n_q^j} , #' #' where: #' \itemize{ #' \item \eqn{n} is the total number of samples; #' \item \eqn{n_q^j} is the number of samples in cluster \eqn{q} that belongs to #' original class \eqn{j} (\eqn{1 \leq j \leq l}). #' } #' #' The purity is therefore a real number in \eqn{[0,1]}. #' The larger the purity, the better the clustering performance. #' #' @param x an object that can be interpreted as a factor or can generate such an object, e.g. via #' a suitable method \code{\link{predict}}, which gives the cluster membership for each sample. #' @param y a factor or an object coerced into a factor that gives the true class labels for each sample. #' It may be missing if \code{x} is a contingency table. #' @param ... extra arguments to allow extension, and usually passed to the next method. #' #' @return a single numeric value #' @family assess #' @export #' #' @examples #' # generate a synthetic dataset with known classes: 50 features, 18 samples (5+5+8) #' n <- 50; counts <- c(5, 5, 8); #' V <- syntheticNMF(n, counts) #' cl <- unlist(mapply(rep, 1:3, counts)) #' #' # perform default NMF with rank=2 #' x2 <- nmf(V, 2) #' purity(x2, cl) #' entropy(x2, cl) #' # perform default NMF with rank=2 #' x3 <- nmf(V, 3) #' purity(x3, cl) #' entropy(x3, cl) #' setGeneric('purity', function(x, y, ...) standardGeneric('purity') ) #' Computes the purity directly from the contingency table \code{x} setMethod('purity', signature(x='table', y='missing'), function(x, y){ #for each cluster: compute maximum number of samples common to a class t <- apply(x, 1, max) # average and return the result sum(t) / sum(x) } ) #' Computes the purity on the contingency table of \code{x} and \code{y}, that is #' coerced into a factor if necessary. setMethod('purity', 'factor', function(x, y, ...){ # coerce `y` into a factor if necessary if( !is.factor(y) ) y <- as.factor(y) #compute the purity on the contingency table between clusters and true classes (clusters are in rows) purity(table(x, y), ...) } ) #' Default method that should work for results of clustering algorithms, that have a #' suitable \code{predict} method that returns the cluster membership vector: #' the purity is computed between \code{x} and \code{predict{y}} setMethod('purity', 'ANY', function(x, y, ...){ # compute the purity for the samples clusters defined by the profiles purity(predict(x), y, ...) } ) #' Entropy of a Clustering #' #' @details #' The entropy of the clustering with respect to the known categories is given by: #' \deqn{Entropy = - \frac{1}{n \log_2 l} \sum_{q=1}^k \sum_{j=1}^l n_q^j #' \log_2 \frac{n_q^j}{n_q}}{ #' - 1/(n log2(l) ) sum_q sum_j n(q,j) log2( n(q,j) / n_q )}, #' #' where: #' \itemize{ #' \item \eqn{n} is the total number of samples; #' \item \eqn{n}{n_q} is the total number of samples in cluster \eqn{q} (\eqn{1 \leq q \leq k}); #' \item \eqn{n_q^j}{n(q,j)} is the number of samples in cluster \eqn{q} that belongs to #' original class \eqn{j} (\eqn{1 \leq j \leq l}). #' } #' #' The smaller the entropy, the better the clustering performance. #' @inheritParams purity #' #' @return the entropy (i.e. a single numeric value) #' @family assess #' @rdname purity #' @export #' setGeneric('entropy', function(x, y, ...) standardGeneric('entropy') ) #' Computes the purity directly from the contingency table \code{x}. #' #' This is the workhorse method that is eventually called by all other methods. setMethod('entropy', signature(x='table', y='missing'), function(x, y, ...){ #for each cluster: compute the inner sum t <- apply(x, 1, function(n){ c.size <- sum(n); n %*% ifelse( n!=0, log2(n/c.size), 0)} ) # weight and return the result - sum(t) / ( sum(x) * log2(ncol(x)) ) } ) #' Computes the purity on the contingency table of \code{x} and \code{y}, that is #' coerced into a factor if necessary. setMethod('entropy', 'factor', function(x, y, ...){ # coerce `y` into a factor if necessary if( !is.factor(y) ) y <- as.factor(y) #copmute entropy on contingency table between clusters and true classes (clusters are in rows) entropy(table(x, y)) } ) #' Default method that should work for results of clustering algorithms, that have a #' suitable \code{predict} method that returns the cluster membership vector: #' the purity is computed between \code{x} and \code{predict{y}} setMethod('entropy', 'ANY', function(x, y, ...){ # compute the entropy for the samples clusters defined by the metagenes expression matrix entropy(predict(x), y) } ) ###% Extract the genes that characterize each factor. ###% ###% For each factor the genes are first sorted by decreasing contribution. The first successive ones whose contribution to the factor ###% is greater than their contribution to all other metagenes are selected. ###% ###% @param x the matrix of metagenes. That is a matrix with metagenes in column, genes in row, contain the genes' contribution to each factor ###% @return a list with number of metagenes elements, each being a vector containing the indexes of the characterizing genes #setGeneric('computeContrib', function(x, ...) standardGeneric('computeContrib') ) #setMethod('computeContrib', signature(x='matrix'), # function(x, ...){ # # determine the specific genes for each factor # lapply(1:ncol(x), # function(i){ # g <- x[,i] # #order by decreasing contribution to factor i # index.sort <- order(g, decreasing=TRUE) # # for( k in seq_along(index.sort) ) # { # index <- index.sort[k] # #if the gene contributes more to any other factor then return the genes above it # if( any(x[index,-i] >= g[index]) ) # { # if( k == 1 ) return(NULL) # else return(rownames(x)[index.sort[1:(k-1)]]) # } # } # # # all genes are meeting the criteria # rownames(x) # }) # } #) # #' Apply Function for NMF Objects #' #' The function \code{nmfApply} provides exteneded \code{apply}-like #' functionality for objects of class \code{NMF}. #' It enables to easily apply a function over different margins of #' NMF models. #' #' The function \code{FUN} is applied via a call to \code{\link{apply}} #' or \code{\link{sapply}} according to the value of argument \code{MARGIN} #' as follows: #' #' \describe{ #' \item{MARGIN=1}{ apply \code{FUN} to each \emph{row} of the basis matrix: #' \code{apply(basis(X), 1L, FUN, ...)}.} #' #' \item{MARGIN=2}{ apply \code{FUN} to each \emph{column} of the coefficient matrix: #' \code{apply(coef(X), 2L, FUN, ...)}.} #' #' \item{MARGIN=3}{ apply \code{FUN} to each \emph{pair} of associated basis component #' and basis profile: #' more or less \code{sapply(seq(nbasis(X)), function(i, ...) FUN(basis(X)[,i], coef(X)[i, ], ...), ...)}. #' #' In this case \code{FUN} must be have at least two arguments, to which are passed #' each basis components and basis profiles respectively -- as numeric vectors.} #' #' \item{MARGIN=4}{ apply \code{FUN} to each \emph{column} of the basis matrix, i.e. to each #' basis component: #' \code{apply(basis(X), 2L, FUN, ...)}.} #' #' \item{MARGIN=5}{ apply \code{FUN} to each \emph{row} of the coefficient matrix: #' \code{apply(coef(X), 1L, FUN, ...)}.} #' #' } #' #' #' @param X an object that has suitable \code{\link{basis}} and \code{coef} methods, #' e.g. an NMF model. #' @param MARGIN a single numeric (integer) value that specifies over which margin(s) #' the function \code{FUN} is applied. #' See section \emph{Details} for a list of possible values. #' @param FUN a function to apply over the specified margins. #' @param ... extra arguments passed to \code{FUN} #' @param simplify a logical only used when \code{MARGIN=3}, that indicates if \code{sapply} #' should try to simplify result if possible. #' Since this argument follows \sQuote{...} its name cannot be abbreviated. #' @param USE.NAMES a logical only used when \code{MARGIN=3}, that indicates if \code{sapply} #' should use the names of the basis components to name the results if present. #' Since this argument follows \sQuote{...} its name cannot be abbreviated. #' #' @return a vector or a list. #' See \code{\link[base]{apply}} and \code{\link[base]{sapply}} for more details on #' the output format. #' #' @export #setGeneric('nmfApply', function(object, ...) standardGeneric('nmfApply') ) nmfApply <- function(X, MARGIN, FUN, ..., simplify = TRUE, USE.NAMES = TRUE){ if( MARGIN == 1L ) apply(basis(X), 1L, FUN, ...) else if( MARGIN == 4L ) apply(basis(X), 2L, FUN, ...) else if( MARGIN == 2L ) apply(coef(X), 2L, FUN, ...) else if( MARGIN == 5L ) apply(coef(X), 1L, FUN, ...) else if( MARGIN == 3L ){ b <- basis(X) p <- coef(X) sapply(setNames(seq(nbasis(X), basisnames(X))) , function(i, ...) FUN(b[,i], p[i,], ...) , simplify = simplify, USE.NAMES = USE.NAMES) }else stop("invalid argument 'MARGIN' (expected values are: 1-basis rows, 2-coef columns, 3-(basis columns, coef rows), or 4-basis columns or 5-coef rows)") } ###% Utility function to compute the dominant column for each row for a matrix. .predict.nmf <- function(x, prob=FALSE){ if( !is.matrix(x) ) stop('NMF:::.predict.nmf : only works on matrices') if( !prob ){ #for each column return the (row) index of the maximum return( as.factor(apply(x, 1L, function(v) which.max(abs(v)))) ) } else{ #for each column return the (row) index of the maximum AND the associated probaility res <- apply(x, 1L, function(p){ p <- abs(p) i <- which.max(p) c(i, p[i]/sum(p)) } ) # return the result as a list of two elements return( list(predict=as.factor(res[1,]), prob=res[2,]) ) } } #' Clustering and Prediction #' #' The methods \code{predict} for NMF models return the cluster membership #' of each sample or each feature. #' Currently the classification/prediction of new data is not implemented. #' #' The cluster membership is computed as the index of the dominant basis #' component for each sample (\code{what='samples' or 'columns'}) or each feature #' (\code{what='features' or 'rows'}), based on their corresponding #' entries in the coefficient matrix or basis matrix respectively. #' #' For example, if \code{what='samples'}, then the dominant basis component #' is computed for each column of the coefficient matrix as the row index #' of the maximum within the column. #' #' If argument \code{prob=FALSE} (default), the result is a \code{factor}. #' Otherwise a list with two elements is returned: element \code{predict} #' contains the cluster membership index (as a \code{factor}) and element #' \code{prob} contains the relative contribution of #' the dominant component to each sample (resp. the relative contribution of #' each feature to the dominant basis component): #' #' \itemize{ #' \item Samples: \deqn{p_j = x_{k_0} / \sum_k x_k}{p(j) = x(k0) / sum_k x(k)}, #' for each sample \eqn{1\leq j \leq p}, where \eqn{x_k}{x(k)} is the contribution #' of the \eqn{k}-th basis component to \eqn{j}-th sample (i.e. \code{H[k ,j]}), and #' \eqn{x_{k_0}}{x(k0)} is the maximum of these contributions. #' #' \item Features: \deqn{p_i = y_{k_0} / \sum_k y_k}{p(i) = y(k0) / sum_k y(k)}, #' for each feature \eqn{1\leq i \leq p}, where \eqn{y_k}{y(k)} is the contribution #' of the \eqn{k}-th basis component to \eqn{i}-th feature (i.e. \code{W[i, k]}), and #' \eqn{y_{k_0}}{y(k0)} is the maximum of these contributions. #' #' } #' #' @param object an NMF model #' #' @family stats Methods for the Interface Defined in Package stats #' #' @cite Brunet2004,Pascual-Montano2006 #' @inline #' @export setGeneric('predict', package='stats') #' Default method for NMF models #' #' @param what a character string that indicates the type of cluster membership should #' be returned: \sQuote{columns} or \sQuote{rows} for clustering the colmuns or the #' rows of the target matrix respectively. #' The values \sQuote{samples} and \sQuote{features} are aliases for \sQuote{colmuns} #' and \sQuote{rows} respectively. #' @param prob logical that indicates if the relative contributions of/to the dominant #' basis component should be computed and returned. See \emph{Details}. #' @param dmatrix logical that indicates if a dissimiliarity matrix should be #' attached to the result. #' This is notably used internally when computing NMF clustering silhouettes. #' #' @examples #' #' # random target matrix #' v <- rmatrix(20, 10) #' # fit an NMF model #' x <- nmf(v, 5) #' #' # predicted column and row clusters #' predict(x) #' predict(x, 'rows') #' #' # with relative contributions of each basis component #' predict(x, prob=TRUE) #' predict(x, 'rows', prob=TRUE) #' setMethod('predict', 'NMF', function(object, what=c('columns', 'rows', 'samples', 'features'), prob=FALSE, dmatrix = FALSE){ # determine which matrix to use for the prediction what <- match.arg(what) x <- if( what %in% c('features', 'rows') ) basis(object, all=FALSE) else t(coef(object, all=FALSE)) # compute the indice of the dominant row for each column res <- .predict.nmf(x, prob) # attach dissimilarity matrix if requested if( dmatrix ){ attr(res, 'dmatrix') <- 1 - cor(t(x)) } return( res ) } ) ####% Compute the dominant column for each row. ####% ####% @param x a matrix containing the mixture coefficients (basis vector in rows, samples in columns) ####% @return a factor of length the number of columns, giving the dominant column for each row ####% @note This function is now deprecated #setGeneric('clusters', function(object, newdata, ...) standardGeneric('clusters') ) ####% Compute the dominant metagene for each sample. ####% ####% @param x a NMF object ####% @return a factor of length the number of samples, giving the dominant metagene for each sample ####% @note This function is now deprecated #setMethod('clusters', signature(object='NMF', newdata='missing'), # function(object, newdata, ...){ # predict(object, ...) # } #) #' Correlations in NMF Models #' #' \code{basiscor} computes the correlation matrix between basis vectors, i.e. #' the \emph{columns} of its basis matrix -- which is the model's first matrix factor. #' #' @details #' Each generic has methods defined for computing correlations between NMF models #' and/or compatible matrices. #' The computation is performed by the base function \code{\link{cor}}. #' #' @param x a matrix or an object with suitable methods \code{\link{basis}} #' or \code{\link{coef}}. #' @param y a matrix or an object with suitable methods \code{\link{basis}} #' or \code{\link{coef}}, and dimensions compatible with \code{x}. #' If missing the correlations are computed between \code{x} and \code{y=x}. #' @param ... extra arguments passed to \code{\link{cor}}. #' #' @export #' @family NMFplots Plotting functions for NMF objects #' #' @examples #' #' # generate two random NMF models #' a <- rnmf(3, 100, 20) #' b <- rnmf(3, 100, 20) #' #' # Compute auto-correlations #' basiscor(a) #' profcor(a) #' # Compute correlations with b #' basiscor(a, b) #' profcor(a, b) #' #' # try to recover the underlying NMF model 'a' from noisy data #' res <- nmf(fitted(a) + rmatrix(a), 3) #' #' # Compute correlations with the true model #' basiscor(a, res) #' profcor(a, res) #' #' # Compute correlations with a random compatible matrix #' W <- rmatrix(basis(a)) #' basiscor(a, W) #' identical(basiscor(a, W), basiscor(W, a)) #' #' H <- rmatrix(coef(a)) #' profcor(a, H) #' identical(profcor(a, H), profcor(H, a)) #' setGeneric('basiscor', function(x, y, ...) standardGeneric('basiscor') ) #' Computes the correlations between the basis vectors of \code{x} and #' the columns of \code{y}. setMethod('basiscor', signature(x='NMF', y='matrix'), function(x, y, ...){ cor(basis(x), y, ...) } ) #' Computes the correlations between the columns of \code{x} #' and the the basis vectors of \code{y}. setMethod('basiscor', signature(x='matrix', y='NMF'), function(x, y, ...){ cor(x, basis(y), ...) } ) #' Computes the correlations between the basis vectors of \code{x} and \code{y}. setMethod('basiscor', signature(x='NMF', y='NMF'), function(x, y, ...){ basiscor(x, basis(y), ...) } ) #' Computes the correlations between the basis vectors of \code{x}. setMethod('basiscor', signature(x='NMF', y='missing'), function(x, y, ...){ basiscor(x, x, ...) } ) #' Correlations of Basis Profiles #' #' \code{profcor} computes the correlation matrix between basis profiles, #' i.e. the \emph{rows} of the coefficient matrix -- which is the model's second #' matrix factor. #' #' @rdname basiscor #' @export #' setGeneric('profcor', function(x, y, ...) standardGeneric('profcor') ) #' Computes the correlations between the basis profiles of \code{x} and #' the rows of \code{y}. setMethod('profcor', signature(x='NMF', y='matrix'), function(x, y, ...){ cor(t(coef(x)), t(y), ...) } ) #' Computes the correlations between the rows of \code{x} and the basis #' profiles of \code{y}. setMethod('profcor', signature(x='matrix', y='NMF'), function(x, y, ...){ cor(t(x), t(coef(y)), ...) } ) #' Computes the correlations between the basis profiles of \code{x} and \code{y}. setMethod('profcor', signature(x='NMF', y='NMF'), function(x, y, ...){ profcor(x, coef(y), ...) } ) #' Computes the correlations between the basis profiles of \code{x}. setMethod('profcor', signature(x='NMF', y='missing'), function(x, y, ...){ profcor(x, x, ...) } ) #' Clustering Connectivity and Consensus Matrices #' #' \code{connectivity} is an S4 generic that computes the connectivity matrix #' based on the clustering of samples obtained from a model's \code{\link{predict}} #' method. #' #' The connectivity matrix of a given partition of a set of samples (e.g. given #' as a cluster membership index) is the matrix \eqn{C} containing only 0 or 1 #' entries such that: #' \deqn{C_{ij} = \left\{\begin{array}{l} #' 1\mbox{ if sample }i\mbox{ belongs to the same cluster as sample }j\\ #' 0\mbox{ otherwise} #' \end{array}\right..}{ #' C_{ij} = 1 if sample i belongs to the same cluster as sample j, 0 otherwise} #' #' @param object an object with a suitable \code{\link{predict}} method. #' @param ... extra arguments to allow extension. #' They are passed to \code{\link{predict}}, except for the \code{vector} and #' \code{factor} methods. #' #' @return a square matrix of dimension the number of samples in the model, full #' of 0s or 1s. #' #' @seealso \code{\link{predict}} #' #' @export #' setGeneric('connectivity', function(object, ...) standardGeneric('connectivity') ) #' Default method which computes the connectivity matrix #' using the result of \code{predict(x, ...)} as cluster membership index. #' #' @examples #' #' # clustering of random data #' h <- hclust(dist(rmatrix(10,20))) #' connectivity(cutree(h, 2)) #' setMethod('connectivity', 'ANY', function(object, ...){ c <- predict(object, ...); outer(c, c, function(x,y) ifelse(x==y, 1,0)); } ) #' Computes the connectivity matrix using \code{x} as cluster membership index. #' #' @examples #' connectivity(gl(2, 4)) #' setMethod('connectivity', 'factor', function(object, ...){ outer(object, object, function(x,y) ifelse(x==y, 1,0)); } ) #' Equivalent to \code{connectivity(as.factor(x))}. setMethod('connectivity', 'numeric', function(object, ...){ connectivity(as.factor(object), ...) } ) #' Computes the connectivity matrix for an NMF model, for which cluster #' membership is given by the most contributing basis component in each sample. #' See \code{\link{predict,NMF-method}}. #' #' @inline #' @param no.attrib a logical that indicates if attributes containing information #' about the NMF model should be attached to the result (\code{TRUE}) or not #' (\code{FALSE}). #' setMethod('connectivity', 'NMF', function(object, no.attrib=FALSE){ C <- callNextMethod(object=object, what='samples'); if( !no.attrib ){ class(C) <- c(class(C), 'NMF.consensus') attr(C, 'model') <- object attr(C, 'nrun') <- 1 attr(C, 'nbasis') <- nbasis(object) } C } ) # Unit test unit.test(connectivity,{ # build reference matrix n <- 10 ref <- matrix(0, 2*n, 2*n) ref[1:n,1:n] <- 1 ref[(n+1):(2*n),(n+1):(2*n)] <- 1 checkIdentical(connectivity(gl(2, n)), ref, 'Factor') checkIdentical(connectivity(as.numeric(gl(2, n))), ref, 'Vector') # test with NMF model i <- gl(2, n) x <- nmfModel(H=matrix(c(rev(i), i), 2, byrow=TRUE)) checkEquals(connectivity(x), ref, 'NMF model', check.attributes = FALSE) s <- sample.int(2*n) checkEquals(connectivity(x[,s]), ref[s,s], 'NMF model (shuffled)', check.attributes = FALSE) }) #' Residual Sum of Squares and Explained Variance #' #' \code{rss} and \code{evar} are S4 generic functions that respectively computes #' the Residual Sum of Squares (RSS) and explained variance achieved by a model. #' #' @param object an R object with a suitable \code{\link{fitted}}, \code{rss} or #' \code{evar} method. #' @param ... extra arguments to allow extension, e.g. passed to \code{rss} #' in \code{evar} calls. #' #' @return a single numeric value #' @inline #' @export #' setGeneric('rss', function(object, ...) standardGeneric('rss')) #' Computes the RSS between a target matrix and its estimate \code{object}, #' which must be a matrix of the same dimensions as \code{target}. #' #' The RSS between a target matrix \eqn{V} and its estimate \eqn{v} is computed as: #' \deqn{RSS = \sum_{i,j} (v_{ij} - V_{ij})^2} #' #' Internally, the computation is performed using an optimised C++ implementation, #' that is light in memory usage. #' #' @param target target matrix #' #' @examples #' # RSS bewteeen random matrices #' x <- rmatrix(20,10, max=50) #' y <- rmatrix(20,10, max=50) #' rss(x, y) #' rss(x, x + rmatrix(x, max=0.1)) #' setMethod('rss', 'matrix', function(object, target){ # make sure the target is provided if( missing(target) ) stop("NMF::rss - Argument 'target' is missing and required to compute the residual sum of squares.") # use the expression matrix if necessary if( inherits(target, 'ExpressionSet') ){ # requires Biobase if( !require.quiet(Biobase) ) stop("NMF::rss - The 'Biobase' package is required to extract expression data from 'ExpressionSet' objects [see ?'nmf-bioc']") target <- Biobase::exprs(target) }else if( is.data.frame(target) ) target <- as.matrix(target) # return rss using the optimized C function .rss(object,target) } ) #' Residual sum of square between a given target matrix and a model that has a #' suitable \code{\link{fitted}} method. #' It is equivalent to \code{rss(fitted(object), ...)} #' #' In the context of NMF, \cite{Hutchins2008} used the variation of the RSS #' in combination with the algorithm from \cite{Lee1999} to estimate the #' correct number of basis vectors. #' The optimal rank is chosen where the graph of the RSS first shows an inflexion #' point, i.e. using a screeplot-type criterium. #' See section \emph{Rank estimation} in \code{\link{nmf}}. #' #' Note that this way of estimation may not be suitable for all models. #' Indeed, if the NMF optimisation problem is not based on the Frobenius norm, #' the RSS is not directly linked to the quality of approximation of the NMF model. #' However, it is often the case that it still decreases with the rank. #' #' @examples #' # RSS between an NMF model and a target matrix #' x <- rmatrix(20, 10) #' y <- rnmf(3, x) # random compatible model #' rss(y, x) #' #' # fit a model with nmf(): one should do better #' y2 <- nmf(x, 3) # default minimizes the KL-divergence #' rss(y2, x) #' y2 <- nmf(x, 3, 'lee') # 'lee' minimizes the RSS #' rss(y2, x) #' setMethod('rss', 'ANY', function(object, ...){ rss(fitted(object), ...) } ) unit.test(rss, { x <- rmatrix(20,10, max=50) y <- rmatrix(20,10, max=50) checkIdentical(rss(x, y), sum((x-y)^2), "Random matrices") y <- rnmf(3, x) # random compatible model r1 <- rss(y, x) checkIdentical(r, sum((x-fitted(y))^2), 'NMF model') checkIdentical(rss(y, ExpressionSet(x)), sum((x-fitted(y))^2), 'NMF model (ExpressionSet)') y <- nmf(x, 3) r2 <- rss(y, x) checkIdentical(r2, sum((x-fitted(y))^2), 'Fitted NMF model') checkTrue(r2 < r1, 'Fitted NMF model has better RSS') y <- nmf(x, 3, 'lee') checkTrue(rss(y, x) < r2, "Fitted NMF model with 'lee' has better RSS than 'brunet'") }) #' Explained Variance #' #' The explained variance for a target \eqn{V} is computed as: #' \deqn{evar = 1 - \frac{RSS}{\sum_{i,j} v_{ij}^2} }{evar = 1 - RSS/sum v_{ij}^2}, #' #' where RSS is the residual sum of squares. #' #' The explained variance is usefull to compare the performance of different #' models and their ability to accurately reproduce the original target matrix. #' Note, however, that a possible caveat is that some models explicitly aim at #' minimizing the RSS (i.e. maximizing the explained variance), while others do not. #' #' @rdname rss #' @inline #' @export #' setGeneric('evar', function(object, ...) standardGeneric('evar')) #' Default method for \code{evar}. #' #' It requires a suitable \code{rss} method to be defined #' for \code{object}, as it internally calls \code{rss(object, target, ...)}. setMethod('evar', 'ANY', function(object, target, ...){ # make sure the target is provided if( missing(target) ) stop("NMF::evar - Argument 'target' is missing and required to compute the explained variance.") # use the expression matrix if necessary if( inherits(target, 'ExpressionSet') ){ # requires Biobase if( !require.quiet(Biobase) ) stop("NMF::evar - The 'Biobase' package is required to extract expression data from 'ExpressionSet' objects [see ?'nmf-bioc']") target <- Biobase::exprs(target) } t <- as.numeric(target) 1 - rss(object, target, ...) / sum(t^2) } ) #' Distances and Objective Functions #' #' The NMF package defines methods for the generic \code{deviance} from the package \code{stats}, #' to compute approximation errors between NMF models and matrices, using a variety of #' objective functions. #' #' @return \code{deviance} returns a nonnegative numerical value #' @family stats #' #' @export setGeneric('deviance', package='stats') #' Computes the distance between a matrix and the estimate of an \code{NMF} model. #' #' @param y a matrix compatible with the NMF model \code{object}, i.e. \code{y} #' must have the same dimension as \code{fitted(object)}. #' @param method a character string or a function with signature #' \code{(x="NMF", y="matrix", ...)} that implements a distance measure between #' an NMF model \code{x} and a target matrix \code{y}, i.e. an objective function #' to use to compute the deviance. #' In \code{deviance}, it is passed to \code{nmfDistance} to get the function #' that effectively computes the deviance. #' @param ... extra parameters passed to the objective function. #' #' @inline #' @family stats #' setMethod('deviance', 'NMF', function(object, y, method=c('', 'KL', 'euclidean'), ...){ fun <- nmfDistance(method) if( is.null(fun) ){ warning('Undefined distance method: distance cannot be computed [returned NA]') return(as.numeric(NA)) } # extract expression data from ExpressionSet objects if( is(y, 'ExpressionSet') ) y <- Biobase::exprs(y) # apply the function and return the result fun(object, y, ...) } ) #' \code{nmfDistance} returns a function that computes the distance between an NMF model and a #' compatible matrix. #' #' @return \code{nmfDistance} returns a function with least two arguments: #' an NMF model and a matrix. #' #' @export #' @rdname deviance nmfDistance <- function(method=c('', 'KL', 'euclidean')){ #message('compute distance') # determinate the distance measure to use if( is.null(method) ) return(NULL) if( is.character(method) ){ errMeth <- try(method <- match.arg(method), silent=TRUE) # if the method is not predefined, try to find a function with the given name if( inherits(errMeth, 'try-error') ){ #TODO: this is not working with local functions if( is.character(method) ){ errFun <- try(fun <- match.fun(method), silent=TRUE) if( inherits(errFun, 'try-error') ) stop("Could not find distance measure '", method, "':\n\t- not a predefined measures -> ", errMeth,"\t- not a function -> ", errFun) } else fun <- method if( !is.function(fun) ) stop('Invalid distance measure: should be a character string or a valid function definition') } else{ # compute and return the distance measure fun <- switch(method, euclidean = function(x, y, ...){ # call optimized C function .rss(y, fitted(x))/2 }, KL = function(x, y, ...){ # call optimized C function .KL(y, fitted(x)) } ) } } else if( is.function(method) ) fun <- method else stop('Invalid distance measure: should be a character string or a valid function definition') # return the distance function fun } #' Testing Equality of NMF Models #' #' The function \code{nmf.equal} tests if two NMF models are the same, i.e. they #' contain -- almost -- identical data: same basis and coefficient matrices, as #' well as same extra parameters. #' #' @details #' \code{nmf.equal} compares two NMF models, and return \code{TRUE} iff they are #' identical acording to the function \code{\link{identical}} when \code{identical=TRUE}, #' or equal up to some tolerance acording to the function \code{\link{all.equal}}. #' This means that all data contained in the objects are compared, which includes #' at least the basis and coefficient matrices, as well as the extra parameters #' stored in slot \sQuote{misc}. #' #' If extra arguments are specified in \code{...}, then the comparison is performed #' using \code{\link{all.equal}}, irrespective of the value of argument \code{identical}. #' #' @param x an NMF model or an object that is associated with an NMF model, e.g. #' the result from a fit with \code{\link{nmf}}. #' @param y an NMF model or an object that is associated with an NMF model, e.g. #' the result from a fit with \code{\link{nmf}}. #' @param identical a logical that indicates if the comparison should be made #' using the function \code{\link{identical}} (\code{TRUE}) or \code{\link{all.equal}} #' (\code{FALSE}). See description for method \code{nmf.equal,NMF,NMF}. #' @param ... extra arguments to allow extension, and passed to subsequent calls #' #' @export #' setGeneric('nmf.equal', function(x, y, ...) standardGeneric('nmf.equal') ) #' Compares two NMF models. #' #' Arguments in \code{...} are used only when \code{identical=FALSE} and are #' passed to \code{all.equal}. #' @inline setMethod('nmf.equal', signature(x='NMF', y='NMF'), function(x, y, identical=TRUE, ...){ dots <- list(...) if( identical && length(dots) == 0 ) identical(x, y) else all.equal(x, y, ...) } ) # Match and Order Basis Components # # match.basis <- function(object, return.table=FALSE){ # compute the contingency table #pcmap <- predict(object, 'cmap') # build the tree from consensus matrix h <- hclust(as.dist(1-consensus(object)), method='average') # extract membership from the tree cl <- cutree(h, k=nbasis(object)) # change the class indexed to match the order of the consensus clusters cl <- match(cl, unique(cl[h$order])) pcmap <- as.factor(cl) occ <- table(consensus=pcmap, fit=predict(object)) # add names if present # if( !is.null(basisnames(object)) ){ # rownames(occ) <- colnames(occ) <- basisnames(object) # } # for each estimated component look for the maximum agreement T.tmp <- occ res <- rep(0, ncol(T.tmp)) for( i in 1:ncol(T.tmp) ){ # get the row and column index of the maximum over the remaining entries xm <- which.max(T.tmp)-1 jm <- xm %/% nrow(T.tmp) + 1 im <- xm - (jm-1) * nrow(T.tmp) + 1 # assign the estimate row to the inferred reference column stopifnot( res[im]==0 ) res[im] <- jm # erase the assigned estimate row T.tmp[im,] <- NA # erase the assigned reference column T.tmp[,jm] <- NA } # return the mapping as an integer vector res <- as.integer(res) if( return.table ) res <- list(match=res, table=occ) # return result res } NMF/R/NMFStrategyFunction-class.R0000644000176000001440000000471112234465004016225 0ustar ripleyusers#' @include NMFStrategy-class.R NULL #' Interface for Single Function NMF Strategies #' #' This class implements the virtual interface \code{\link{NMFStrategy}} for #' NMF algorithms that are implemented by a single workhorse R function. #' #' @slot algorithm a function that implements an NMF algorithm. #' It must have signature \code{(y='matrix', x='NMFfit')}, where \code{y} is the #' target matrix to approximate and \code{x} is the NMF model assumed to be #' seeded with an appropriate initial value -- as it is done internally by #' function \code{\link{nmf}}. #' #' Note that argument names currently do not matter, but it is recommended to #' name them as specified above. #' setClass('NMFStrategyFunction' , representation( algorithm = 'function' # the function that implements the algorithm ) , contains = 'NMFStrategy' ) #' Runs the NMF algorithms implemented by the single R function -- and stored in slot \code{'algorithm'} #' of \code{object}, on the data object \code{y}, using \code{x} as starting point. #' It is equivalent to calling \code{object@@algorithm(y, x, ...)}. #' #' This method is usually not called directly, but only via the function \code{\link{nmf}}, which #' takes care of many other details such as seeding the computation, handling RNG settings, or setting up #' parallelisation. #' #' @rdname NMFStrategy setMethod('run', signature(object='NMFStrategyFunction', y='matrix', x='NMFfit'), function(object, y, x, ...){ if( !is.function(fun <- algorithm(object)) ) stop("NMFStrategyFunction '", name(object), "': algorithm is not defined.") # run the function that defines the algorithm and return the result fun(y, x, ...) } ) #' @S3method nmfFormals NMFStrategyFunction nmfFormals.NMFStrategyFunction <- function(x, ...){ args <- formals(x@algorithm) args[-(1:2)] } #' Returns the single R function that implements the NMF algorithm -- as stored in #' slot \code{algorithm}. setMethod('algorithm', signature(object='NMFStrategyFunction'), function(object){ slot(object, 'algorithm') } ) #setReplaceMethod('algorithm', signature(object='NMFStrategyFunction', value='character'), # function(object, value){ # slot(object, 'algorithm') <- value # object # } #) #' Sets the function that implements the NMF algorithm, stored in slot \code{algorithm}. setReplaceMethod('algorithm', signature(object='NMFStrategyFunction', value='function'), function(object, value){ slot(object, 'algorithm') <- value object } ) NMF/R/colorcode.R0000644000176000001440000001330612234465004013222 0ustar ripleyusers# Functions to define/extract compact colour specifications # # Author: "Renaud Gaujoux" # Creation: 19 Sep 2011 ############################################################################### #' @import RColorBrewer #' @import colorspace #' @import grDevices NULL col2hex <- function (cname) { colMat <- col2rgb(cname) rgb(red = colMat[1, ]/255, green = colMat[2, ]/255, blue = colMat[3,]/255) } #cc <- function(x, cval=80, lval=30){ # # sapply(x, function(co){ # if( is.integer(co) ) col2hex(if( co <= 8 ) co else colors()[co]) # else if( is.numeric(co) ) hcl(co, c=cval, l=lval) # else if( !grepl("^#") ) # else co # }) # #} #' Flags a Color Palette Specification for Reversion #' @keywords internal revPalette <- function(x){ attr(x, 'revPalette') <- TRUE x } #' Builds a Color Palette from Compact Color Specification #' @keywords internal ccPalette <- function(x, n=NA, verbose=FALSE){ if( length(x)==1 ){ # shortcut for single colors if( (is_NA(n) || n==1) && length(x) > 1L && all(grepl("^#", x)) ) return(x) sp <- ccSpec(x) x <- sp$palette if( is_NA(n) ) n <- sp$n a <- attributes(x) if( is.integer(x) ) # integer code between 1 and 8: R basic colour x <- c("#F1F1F1", col2hex(x)) else if( is.numeric(x) ) # numeric: hcl colour x <- rev(sequential_hcl(2, h = x, l = c(50, 95))) else if( is.character(x) ){ # Palette name: if( require.quiet('RColorBrewer') && x %in% rownames(brewer.pal.info) ){ if( verbose ) message("Load and generate ramp from RColorBrewer colour palette '", x, "'") x <- brewer.pal(brewer.pal.info[x, 'maxcolors'], x) }else{ cpal <- c('RdYlBu2', 'rainbow', 'heat', 'topo', 'terrain', 'cm', 'gray', 'grey') i <- pmatch(x, cpal) if( is.na(i) && (x %in% colours() || grepl("^#[0-9a-fA-F]+$", x)) ){ x <- c("#F1F1F1", x) }else{ if( is.na(i) ){ stop("Invalid palette name '", x, "': should be an RColorBrewer palette or one of " , paste("'", cpal ,"'", sep='', collapse=', ') , ".\n Available RColorBrewer palettes: ", str_out(rownames(brewer.pal.info), Inf), '.') } x <- cpal[i] # use default value of 10 for n if not specified np <- if( is_NA(n) ) 10 else n x <- switch(x , RdYlBu2 = c("#D73027", "#FC8D59", "#FEE090", "#FFFFBF", "#E0F3F8", "#91BFDB", "#4575B4") , rainbow = rainbow(np) , gray = rev(gray.colors(np)) , grey = rev(grey.colors(np)) , heat = heat.colors(np) , topo = topo.colors(np) , terrain = terrain.colors(np) , cm = cm.colors(np) , stop("Unknown colour palette name: '", x, "'") ) } } } else stop("Invalid colour palette specification :", x) attributes(x) <- a } # revert the palette if requested if( !is.null(attr(x, 'revPalette')) ){ x <- rev(x) attr(x, 'revPalette') <- NULL } # limit to the requested length if( !is_NA(n) ) x <- x[1:n] # return converted palette x } #' Generate Break Intervals from Numeric Variables #' #' Implementation is borrowed from the R core function \code{\link{cut.default}}. #' #' @keywords internal ccBreaks <- function(x, breaks){ if (!is.numeric(x)) stop("'x' must be numeric") if (length(breaks) == 1L) { if (is.na(breaks) | breaks < 2L) stop("Invalid number of intervals: should be >= 2") nb <- as.integer(breaks + 1) dx <- diff(rx <- range(x, na.rm = TRUE)) if (dx == 0) dx <- abs(rx[1L]) breaks <- seq.int(rx[1L] - dx/1000, rx[2L] + dx/1000, length.out = nb) } else nb <- length(breaks <- sort.int(as.double(breaks))) if (anyDuplicated(breaks)) stop("'breaks' are not unique") breaks } #' Extract Colour Palette Specification #' #' @param a character string that specify a colour palette. #' @return a list with elements: palette, n and rev #' #' @keywords internal ccSpec <- function(x){ n <- NA rv <- FALSE if( length(x) == 1 ){ if( is.character(x) ){ # flag as reversed if it starts with a '-' if( grepl('^-', x) ){ x <- substr(x, 2, nchar(x)) rv <- TRUE } # extract length for string sm <- str_match(x, "([^:]+):([0-9]+).*")[1,] if( !is_NA(sm[1]) ){ n <- as.integer(sm[3]) x <- sm[2] } # convert to a colour code if possible # use maximum colour number of brewer sets if( is_NA(n) && isString(x) && require.quiet('RColorBrewer') && x %in% rownames(brewer.pal.info) ){ n <- brewer.pal.info[x,'maxcolors'] }else if( grepl("^[1-8]$", x) ){# integer code between 1 and 8: R basic colour x <- palette()[as.integer(x)] }else if( grepl("^[0-9.]+$", x) ) # numeric: hcl colour x <- as.numeric(x) }else if( is.numeric(x) ){ if( x < 0 ){ x <- -x rv<- TRUE } # single integer specification: use R default colours if( isInteger(x) ){ if( x <= 8 ) x <- palette()[x] else x <- colours()[x] } } } if( rv ) x <- revPalette(x) res <- list(palette=x, n=n, rev=rv) # print(res) res } #' Builds a Color Ramp from Compact Color Specification #' #' @keywords internal ccRamp <- function(x, n=NA, ...){ #breaks, data, ...){ # generate random color specification if necessary if( missing(x) ) x <- round(runif(1) * 360) # extract specifications sp <- ccSpec(x) x <- sp$palette if( missing(n) ){ n <- sp$n if( is_NA(n) ) n <- 50 } # create a palette from specification x x <- ccPalette(x, ...) # # compute breaks # breaks <- # if( !missing(breaks) ){ # breaks <- ccBreaks(x, breaks) # if( missing(n) ) # n <- length(breaks) # breaks # } # else if( !missing(data) ){ # if( missing(n) ) # n <- length(x) # ccBreaks(data, n) # } if( is_NA(n) ) n <- length(x) # return ramp from palette colorRampPalette(x)(n+1) } NMF/R/algorithms-lnmf.R0000644000176000001440000000506212234465004014354 0ustar ripleyusers# Algorithm for Nonnegative Matrix Factorization: Local NMF (LNMF) # # @author Renaud Gaujoux # @created 21 Jul 2009 #' @include registry-algorithms.R NULL ###% \item{\sQuote{lnmf}}{ Local Nonnegative Matrix Factorization. Based on a ###% regularized Kullback-Leibler divergence, it uses a modified version of ###% Lee and Seung's multiplicative updates. ###% See \emph{Li et al. (2001)}.} ###% Algorithm for Nonnegative Matrix Factorization: Local NMF (LNMF). ###% ###% The local NMF algorithm is minimizes use the following Kullback-Leibler divergence based objective function: ###% $$ ###% \sum_{i=1}^m\sum_{j=1}^n\left(X_{ij} \log\frac{X_{ij}}{(WH)_{ij}} - X_{ij} + (WH)_{ij} + \alpha U_{ij}\right) - \beta \sum_i V_{ij}, ###% $$ ###% where $\alpha, \beta > 0$ are some constants, $U = W^TW$ and $V = HH^T$. ###% ###% TODO: add explaination for each terms (see Wild 2002) ###% ###% @references Learning spatially localized, parts-based representation ###% , S.Z. Li, X.W. Hou, and H.J. Zhang. ###% , In Proceedings of IEEE International Conference on Computer Vision and Pattern Recognition ###% , December 2001 nmf_update_R.lnmf <- function(i, v, data, ...){ # retrieve each factor w <- .basis(data); h <- .coef(data); # update H h <- sqrt( h * crossprod(w, v / (w %*% h)) ) # update W using the standard divergence based update w <- R_std.divergence.update.w(v, w, h, w %*% h) # scale columns of W w <- sweep(w, 2L, colSums(w), "/", check.margin=FALSE) #every 10 iterations: adjust small values to avoid underflow if( i %% 10 == 0 ){ #precision threshold for numerical stability eps <- .Machine$double.eps h[h\n") cat("name:\t", name(object), "\n") svalue <- algorithm(object) svalue <- if( is.function(svalue) ) '' else paste("'", svalue,"'", sep='') cat("method:\t", svalue, "\n") return(invisible()) } ) #' Returns the workhorse function of the seeding method described by \code{object}. setMethod('algorithm', signature(object='NMFSeed'), function(object){ slot(object, 'method') } ) #' Sets the workhorse function of the seeding method described by \code{object}. setReplaceMethod('algorithm', signature(object='NMFSeed', value='function'), function(object, value){ slot(object, 'method') <- value validObject(object) object } ) #' \code{NMFSeed} is a constructor method that instantiate #' \code{\linkS4class{NMFSeed}} objects. #' #' @param key access key as a single character string #' @param method specification of the seeding method, as a function that takes #' at least the following arguments: #' \describe{ #' \item{object}{uninitialised/empty NMF model, i.e. that it has 0 rows and #' columns, but has already the rank requested in the call to \code{\link{nmf}} #' or \code{\link{seed}}.} #' \item{x}{target matrix} #' \item{...}{extra arguments} #' } #' #' @export #' @rdname setNMFSeed #' @inline setGeneric('NMFSeed', function(key, method, ...) standardGeneric('NMFSeed') ) #' Default method simply calls \code{\link{new}} with the same arguments. setMethod('NMFSeed', signature(key='character', method='ANY'), function(key, method, ...){ # wrap function method into a new NMFSeed object new('NMFSeed', name=key, method=method, ..., package=topns_name()) } ) #' Creates an \code{NMFSeed} based on a template object (Constructor-Copy), #' in particular it uses the \strong{same} name. setMethod('NMFSeed', signature(key='NMFSeed', method='ANY'), function(key, method, ...){ # do not change the object if single argument if( nargs() == 1L ) return(key) # build an object based on template object new(class(method), key, method=method, ..., package=topns_name()) } ) NMF/R/algorithms-snmf.R0000644000176000001440000006060612305630424014367 0ustar ripleyusers#' @include registry-algorithms.R NULL #' Fast Combinatorial Nonnegative Least-Square #' #' This function solves the following nonnegative least square linear problem #' using normal equations and the fast combinatorial strategy from \cite{VanBenthem2004}: #' #' \deqn{ #' \begin{array}{l} #' \min \|Y - X K\|_F\\ #' \mbox{s.t. } K>=0 #' \end{array} #' }{min ||Y - X K||_F, s.t. K>=0} #' #' where \eqn{Y} and \eqn{X} are two real matrices of dimension \eqn{n \times p}{n x p} #' and \eqn{n \times r}{n x r} respectively, #' and \eqn{\|.\|_F}{|.|_F} is the Frobenius norm. #' #' The algorithm is very fast compared to other approaches, as it is optimised #' for handling multiple right-hand sides. #' #' @details #' Within the \code{NMF} package, this algorithm is used internally by the #' SNMF/R(L) algorithm from \cite{KimH2007} to solve general Nonnegative #' Matrix Factorization (NMF) problems, using alternating nonnegative #' constrained least-squares. #' That is by iteratively and alternatively estimate each matrix factor. #' #' The algorithm is an active/passive set method, which rearrange the #' right-hand side to reduce the number of pseudo-inverse calculations. #' It uses the unconstrained solution \eqn{K_u} obtained from the #' unconstrained least squares problem, #' i.e. \eqn{\min \|Y - X K\|_F^2}{min ||Y - X K||_F^2} , so as to determine #' the initial passive sets. #' #' The function \code{fcnnls} is provided separately so that it can be #' used to solve other types of nonnegative least squares problem. #' For faster computation, when multiple nonnegative least square fits #' are needed, it is recommended to directly use the function \code{\link{.fcnnls}}. #' #' The code of this function is a port from the original MATLAB code #' provided by \cite{KimH2007}. #' #' @inheritParams .fcnnls #' @param ... extra arguments passed to the internal function \code{.fcnnls}. #' Currently not used. #' @return A list containing the following components: #' #' \item{x}{ the estimated optimal matrix \eqn{K}.} \item{fitted}{ the fitted #' matrix \eqn{X K}.} \item{residuals}{ the residual matrix \eqn{Y - X K}.} #' \item{deviance}{ the residual sum of squares between the fitted matrix #' \eqn{X K} and the target matrix \eqn{Y}. That is the sum of the square #' residuals.} \item{passive}{ a \eqn{r x p} logical matrix containing the #' passive set, that is the set of entries in \eqn{K} that are not null (i.e. #' strictly positive).} \item{pseudo}{ a logical that is \code{TRUE} if the #' computation was performed using the pseudoinverse. See argument #' \code{pseudo}.} #' #' @seealso \code{\link{nmf}} #' @references #' #' Original MATLAB code from Van Benthem and Keenan, slightly modified by H. #' Kim:\cr \url{http://www.cc.gatech.edu/~hpark/software/fcnnls.m} #' #' @author #' Original MATLAB code : Van Benthem and Keenan #' #' Adaption of MATLAB code for SNMF/R(L): H. Kim #' #' Adaptation to the NMF package framework: Renaud Gaujoux #' #' @keywords optimize multivariate regression #' @export #' @inline #' @examples #' #' ## Define a random nonnegative matrix matrix #' n <- 200; p <- 20; r <- 3 #' V <- rmatrix(n, p) #' #' ## Compute the optimal matrix K for a given X matrix #' X <- rmatrix(n, r) #' res <- fcnnls(X, V) #' #' ## Compute the same thing using the Moore-Penrose generalized pseudoinverse #' res <- fcnnls(X, V, pseudo=TRUE) #' #' ## It also works in the case of single vectors #' y <- runif(n) #' res <- fcnnls(X, y) #' # or #' res <- fcnnls(X[,1], y) #' #' setGeneric('fcnnls', function(x, y, ...) standardGeneric('fcnnls') ) #' This method wraps a call to the internal function \code{.fcnnls}, and #' formats the results in a similar way as other lest-squares methods such #' as \code{\link{lm}}. #' #' @param verbose toggle verbosity (default is \code{FALSE}). #' setMethod('fcnnls', signature(x='matrix', y='matrix'), function(x, y, verbose=FALSE, pseudo=TRUE, ...){ # load corpcor if necessary if( isTRUE(pseudo) ){ library(corpcor) } # call the internal function res <- .fcnnls(x, y, verbose=verbose, pseudo=pseudo, ...) # process the result f <- x %*% res$coef resid <- y - f # set dimnames if( is.null(rownames(res$coef)) ) rownames(res$coef) <- colnames(x) # wrap up the result out <- list(x=res$coef, fitted=f, residuals=resid, deviance=norm(resid, 'F')^2, passive=res$Pset, pseudo=pseudo) class(out) <- 'fcnnls' out } ) #' Shortcut for \code{fcnnls(as.matrix(x), y, ...)}. setMethod('fcnnls', signature(x='numeric', y='matrix'), function(x, y, ...){ fcnnls(as.matrix(x), y, ...) } ) #' Shortcut for \code{fcnnls(x, as.matrix(y), ...)}. setMethod('fcnnls', signature(x='ANY', y='numeric'), function(x, y, ...){ fcnnls(x, as.matrix(y), ...) } ) #' @S3method print fcnnls print.fcnnls <- function(x, ...){ cat("\n") cat("Dimensions:", nrow(x$x)," x ", ncol(x$x), "\n") cat("Residual sum of squares:", x$deviance,"\n") cat("Active constraints:", length(x$passive)-sum(x$passive),"/", length(x$passive), "\n") cat("Inverse method:", if( isTRUE(x$pseudo) ) 'pseudoinverse (corpcor)' else if( is.function(x$pseudo) ) str_fun(x$pseudo) else 'QR (solve)', "\n") invisible(x) } ###% M. H. Van Benthem and M. R. Keenan, J. Chemometrics 2004; 18: 441-450 ###% ###% Given A and C this algorithm solves for the optimal ###% K in a least squares sense, using that ###% A = C*K ###% in the problem ###% min ||A-C*K||, s.t. K>=0, for given A and C. ###% ###% ###% @param C the matrix of coefficients ###% @param A the target matrix of observations ###% ###% @return [K, Pset] ###% #' Internal Routine for Fast Combinatorial Nonnegative Least-Squares #' #' @description #' This is the workhorse function for the higher-level function #' \code{\link{fcnnls}}, which implements the fast nonnegative least-square #' algorithm for multiple right-hand-sides from \cite{VanBenthem2004} to solve #' the following problem: #' #' \deqn{ #' \begin{array}{l} #' \min \|Y - X K\|_F\\ #' \mbox{s.t. } K>=0 #' \end{array} #' }{min ||Y - X K||_F, s.t. K>=0} #' #' where \eqn{Y} and \eqn{X} are two real matrices of dimension \eqn{n \times p}{n x p} #' and \eqn{n \times r}{n x r} respectively, #' and \eqn{\|.\|_F}{|.|_F} is the Frobenius norm. #' #' The algorithm is very fast compared to other approaches, as it is optimised #' for handling multiple right-hand sides. #' #' @param x the coefficient matrix #' @param y the target matrix to be approximated by \eqn{X K}. #' @param verbose logical that indicates if log messages should be shown. #' @param pseudo By default (\code{pseudo=FALSE}) the algorithm uses Gaussian #' elimination to solve the successive internal linear problems, using the #' \code{\link{solve}} function. If \code{pseudo=TRUE} the algorithm uses #' Moore-Penrose generalized \code{\link[corpcor]{pseudoinverse}} from the #' \code{corpcor} package instead of \link{solve}. #' @param eps threshold for considering entries as nonnegative. #' This is an experimental parameter, and it is recommended to #' leave it at 0. #' #' @return A list with the following elements: #' #' \item{coef}{the fitted coefficient matrix.} #' \item{Pset}{the set of passive constraints, as a logical matrix of #' the same size as \code{K} that indicates which element is positive.} #' #' @export .fcnnls <- function(x, y, verbose=FALSE, pseudo=FALSE, eps=0){ # check arguments if( any(dim(y) == 0L) ){ stop("Empty target matrix 'y' [", paste(dim(y), collapse=' x '), "]") } if( any(dim(x) == 0L) ){ stop("Empty regression variable matrix 'x' [", paste(dim(x), collapse=' x '), "]") } # map arguments C <- x A <- y # NNLS using normal equations and the fast combinatorial strategy # # I/O: [K, Pset] = fcnnls(C, A); # K = fcnnls(C, A); # # C is the nObs x lVar coefficient matrix # A is the nObs x pRHS matrix of observations # K is the lVar x pRHS solution matrix # Pset is the lVar x pRHS passive set logical array # # M. H. Van Benthem and M. R. Keenan # Sandia National Laboratories # # Pset: set of passive sets, one for each column # Fset: set of column indices for solutions that have not yet converged # Hset: set of column indices for currently infeasible solutions # Jset: working set of column indices for currently optimal solutions # # Check the input arguments for consistency and initializeerror(nargchk(2,2,nargin)) nObs = nrow(C); lVar = ncol(C); if ( nrow(A)!= nObs ) stop('C and A have imcompatible sizes') pRHS = ncol(A); W = matrix(0, lVar, pRHS); iter=0; maxiter=3*lVar; # Precompute parts of pseudoinverse #CtC = t(C)%*%C; CtA = t(C)%*%A; CtC = crossprod(C); CtA = crossprod(C,A); # Obtain the initial feasible solution and corresponding passive set K = .cssls(CtC, CtA, pseudo=pseudo); Pset = K > 0; K[!Pset] = 0; D = K; # which columns of Pset do not have all entries TRUE? Fset = which( colSums(Pset) != lVar ); #V+# Active set algorithm for NNLS main loop oitr=0; # HKim while ( length(Fset)>0 ) { oitr=oitr+1; if ( verbose && oitr > 5 ) cat(sprintf("%d ",oitr));# HKim #Vc# Solve for the passive variables (uses subroutine below) K[,Fset] = .cssls(CtC, CtA[,Fset, drop=FALSE], Pset[,Fset, drop=FALSE], pseudo=pseudo); # Find any infeasible solutions # subset Fset on the columns that have at least one negative entry Hset = Fset[ colSums(K[,Fset, drop=FALSE] < eps) > 0 ]; #V+# Make infeasible solutions feasible (standard NNLS inner loop) if ( length(Hset)>0 ){ nHset = length(Hset); alpha = matrix(0, lVar, nHset); while ( nHset>0 && (iter < maxiter) ){ iter = iter + 1; alpha[,1:nHset] = Inf; #Vc# Find indices of negative variables in passive set ij = which( Pset[,Hset, drop=FALSE] & (K[,Hset, drop=FALSE] < eps) , arr.ind=TRUE); i = ij[,1]; j = ij[,2] if ( length(i)==0 ) break; hIdx = (j - 1) * lVar + i; # convert array indices to indexes relative to a lVar x nHset matrix negIdx = (Hset[j] - 1) * lVar + i; # convert array indices to index relative to the matrix K (i.e. same row index but col index is stored in Hset) alpha[hIdx] = D[negIdx] / (D[negIdx] - K[negIdx]); alpha.inf <- alpha[,1:nHset, drop=FALSE] minIdx = max.col(-t(alpha.inf)) # get the indce of the min of each row alphaMin = alpha.inf[minIdx + (0:(nHset-1) * lVar)] alpha[,1:nHset] = matrix(alphaMin, lVar, nHset, byrow=TRUE); D[,Hset] = D[,Hset, drop=FALSE] - alpha[,1:nHset, drop=FALSE] * (D[,Hset, drop=FALSE]-K[,Hset, drop=FALSE]); idx2zero = (Hset - 1) * lVar + minIdx; # convert array indices to index relative to the matrix D D[idx2zero] = 0; Pset[idx2zero] = FALSE; K[, Hset] = .cssls(CtC, CtA[,Hset, drop=FALSE], Pset[,Hset, drop=FALSE], pseudo=pseudo); # which column of K have at least one negative entry? Hset = which( colSums(K < eps) > 0 ); nHset = length(Hset); } } #V-# #Vc# Make sure the solution has converged #if iter == maxiter, error('Maximum number iterations exceeded'), end # Check solutions for optimality W[,Fset] = CtA[,Fset, drop=FALSE] - CtC %*% K[,Fset, drop=FALSE]; # which columns have all entries non-positive Jset = which( colSums( (ifelse(!(Pset[,Fset, drop=FALSE]),1,0) * W[,Fset, drop=FALSE]) > eps ) == 0 ); Fset = setdiff(Fset, Fset[Jset]); if ( length(Fset) > 0 ){ #Vc# For non-optimal solutions, add the appropriate variable to Pset # get indice of the maximum in each column mxidx = max.col( t(ifelse(!Pset[,Fset, drop=FALSE],1,0) * W[,Fset, drop=FALSE]) ) Pset[ (Fset - 1) * lVar + mxidx ] = TRUE; D[,Fset] = K[,Fset, drop=FALSE]; } } #V-# # return K and Pset list(coef=K, Pset=Pset) } # ****************************** Subroutine**************************** #library(corpcor) .cssls <- function(CtC, CtA, Pset=NULL, pseudo=FALSE){ # use provided function if( is.function(pseudo) ){ pseudoinverse <- pseudo pseudo <- TRUE } # Solve the set of equations CtA = CtC*K for the variables in set Pset # using the fast combinatorial approach K = matrix(0, nrow(CtA), ncol(CtA)); if ( is.null(Pset) || length(Pset)==0 || all(Pset) ){ K <- (if( !pseudo ) solve(CtC) else pseudoinverse(CtC)) %*% CtA; # K = pseudoinverse(CtC) %*% CtA; #K=pinv(CtC)*CtA; }else{ lVar = nrow(Pset); pRHS = ncol(Pset); codedPset = as.numeric(2.^(seq(lVar-1,0,-1)) %*% Pset); sortedPset = sort(codedPset) sortedEset = order(codedPset) breaks = diff(sortedPset); breakIdx = c(0, which(breaks > 0 ), pRHS); for( k in seq(1,length(breakIdx)-1) ){ cols2solve = sortedEset[ seq(breakIdx[k]+1, breakIdx[k+1])]; vars = Pset[,sortedEset[breakIdx[k]+1]]; K[vars,cols2solve] <- (if( !pseudo ) solve(CtC[vars,vars, drop=FALSE]) else pseudoinverse(CtC[vars,vars, drop=FALSE])) %*% CtA[vars,cols2solve, drop=FALSE]; #K[vars,cols2solve] <- pseudoinverse(CtC[vars,vars, drop=FALSE])) %*% CtA[vars,cols2solve, drop=FALSE]; #TODO: check if this is the right way or needs to be reversed #K(vars,cols2solve) = pinv(CtC(vars,vars))*CtA(vars,cols2solve); } } # return K K } ###% ###% SNMF/R ###% ###% Author: Hyunsoo Kim and Haesun Park, Georgia Insitute of Technology ###% ###% Reference: ###% ###% Sparse Non-negative Matrix Factorizations via Alternating ###% Non-negativity-constrained Least Squares for Microarray Data Analysis ###% Hyunsoo Kim and Haesun Park, Bioinformatics, 2007, to appear. ###% ###% This software requires fcnnls.m, which can be obtained from ###% M. H. Van Benthem and M. R. Keenan, J. Chemometrics 2004; 18: 441-450 ###% ###% NMF: min_{W,H} (1/2) || A - WH ||_F^2 s.t. W>=0, H>=0 ###% SNMF/R: NMF with additional sparsity constraints on H ###% ###% min_{W,H} (1/2) (|| A - WH ||_F^2 + eta ||W||_F^2 ###% + beta (sum_(j=1)^n ||H(:,j)||_1^2)) ###% s.t. W>=0, H>=0 ###% ###% A: m x n data matrix (m: features, n: data points) ###% W: m x k basis matrix ###% H: k x n coefficient matrix ###% ###% function [W,H,i]=nmfsh_comb(A,k,param,verbose,bi_conv,eps_conv) ###% ###% input parameters: ###% A: m x n data matrix (m: features, n: data points) ###% k: desired positive integer k ###% param=[eta beta]: ###% eta (for supressing ||W||_F) ###% if eta < 0, software uses maxmum value in A as eta. ###% beta (for sparsity control) ###% Larger beta generates higher sparseness on H. ###% Too large beta is not recommended. ###% verbos: verbose = 0 for silence mode, otherwise print output ###% eps_conv: KKT convergence test (default eps_conv = 1e-4) ###% bi_conv=[wminchange iconv] biclustering convergence test ###% wminchange: the minimal allowance of the change of ###% row-clusters (default wminchange=0) ###% iconv: decide convergence if row-clusters (within wminchange) ###% and column-clusters have not changed for iconv convergence ###% checks. (default iconv=10) ###% ###% output: ###% W: m x k basis matrix ###% H: k x n coefficient matrix ###% i: the number of iterations ###% ###% sample usage: ###% [W,H]=nmfsh_comb(amlall,3,[-1 0.01],1); ###% [W,H]=nmfsh_comb(amlall,3,[-1 0.01],1,[3 10]); ###% -- in the convergence check, the change of row-clusters to ###% at most three rows is allowed. ###% ###% #function [W,H,i] nmf_snmf <- function(A, x, maxIter= nmf.getOption('maxIter') %||% 20000L, eta=-1, beta=0.01, bi_conv=c(0, 10), eps_conv=1e-4, version=c('R', 'L'), verbose=FALSE){ #nmfsh_comb <- function(A, k, param, verbose=FALSE, bi_conv=c(0, 10), eps_conv=1e-4, version=c('R', 'L')){ # depending on the version: # in version L: A is transposed while W and H are swapped and transposed version <- match.arg(version) if( version == 'L' ) A <- t(A) #if( missing(param) ) param <- c(-1, 0.01) m = nrow(A); n = ncol(A); erravg1 = numeric(); #eta=param[1]; beta=param[2]; maxA=max(A); if ( eta<0 ) eta=maxA; eta2=eta^2; # bi_conv if( length(bi_conv) != 2 ) stop("SNMF/", version, "::Invalid argument 'bi_conv' - value should be a 2-length numeric vector") wminchange=bi_conv[1]; iconv=bi_conv[2]; ## VALIDITY of parameters # eps_conv if( eps_conv <= 0 ) stop("SNMF/", version, "::Invalid argument 'eps_conv' - value should be positive") # wminchange if( wminchange < 0 ) stop("SNMF/", version, "::Invalid argument 'bi_conv' - bi_conv[1] (i.e 'wminchange') should be non-negative") # iconv if( iconv < 0 ) stop("SNMF/", version, "::Invalid argument 'bi_conv' - bi_conv[2] (i.e 'iconv') should be non-negative") # beta if( beta <=0 ) stop("SNMF/", version, "::Invalid argument 'beta' - value should be positive") ## # initialize random W if no starting point is given if( isNumber(x) ){ # rank is given by x k <- x message('# NOTE: Initialise W internally (runif)') W <- matrix(runif(m*k), m,k); x <- NULL } else if( is.nmf(x) ){ # rank is the number of basis components in x k <- nbasis(x) # seed the method (depends on the version to run) start <- if( version == 'R' ) basis(x) else t(coef(x)) # check compatibility of the starting point with the target matrix if( any(dim(start) != c(m,k)) ) stop("SNMF/", version, " - Invalid initialization - incompatible dimensions [expected: ", paste(c(m,k), collapse=' x '),", got: ", paste(dim(start), collapse=' x '), " ]") # use the supplied starting point W <- start }else{ stop("SNMF/", version, ' - Invalid argument `x`: must be a single numeric or an NMF model [', class(x), ']') } if ( verbose ) cat(sprintf("--\nAlgorithm: SNMF/%s\nParameters: k=%d eta=%.4e beta (for sparse H)=%.4e wminchange=%d iconv=%d\n", version, k,eta,beta,wminchange,iconv)); idxWold=rep(0, m); idxHold=rep(0, n); inc=0; # check validity of seed if( any(NAs <- is.na(W)) ) stop("SNMF/", version, "::Invalid initialization - NAs found in the ", if(version=='R') 'basis (W)' else 'coefficient (H)' , " matrix [", sum(NAs), " NAs / ", length(NAs), " entries]") # normalize columns of W W= apply(W, 2, function(x) x / sqrt(sum(x^2)) ); I_k=diag(eta, k); betavec=rep(sqrt(beta), k); nrestart=0; i <- 0L while( i < maxIter){ i <- i + 1L # min_h ||[[W; 1 ... 1]*H - [A; 0 ... 0]||, s.t. H>=0, for given A and W. res = .fcnnls(rbind(W, betavec), rbind(A, rep(0, n))); H = res[[1]] if ( any(rowSums(H)==0) ){ if( verbose ) cat(sprintf("iter%d: 0 row in H eta=%.4e restart!\n",i,eta)); nrestart=nrestart+1; if ( nrestart >= 10 ){ warning("NMF::snmf - Too many restarts due to too big 'beta' value [Computation stopped after the 9th restart]"); break; } # re-initialize random W idxWold=rep(0, m); idxHold=rep(0, n); inc=0; erravg1 <- numeric();# re-initialize base average error W=matrix(runif(m*k), m,k); W= apply(W, 2, function(x) x / sqrt(sum(x^2)) ); # normalize columns of W next; } # min_w ||[H'; I_k]*W' - [A'; 0]||, s.t. W>=0, for given A and H. res = .fcnnls(rbind(t(H), I_k), rbind(t(A), matrix(0, k,m))); Wt = res[[1]] W= t(Wt); # track the error (not computed unless tracking option is enabled in x) if( !is.null(x) ) x <- trackError(x, .snmf.objective(A, W, H, eta, beta), niter=i) # test convergence every 5 iterations OR if the base average error has not been computed yet if ( (i %% 5==0) || (length(erravg1)==0) ){ # indice of maximum for each row of W idxW = max.col(W) # indice of maximum for each column of H idxH = max.col(t(H)) changedW=sum(idxW != idxWold); changedH=sum(idxH != idxHold); if ( (changedW<=wminchange) && (changedH==0) ) inc=inc+1 else inc=0 resmat=pmin(H, crossprod(W) %*% H - t(W) %*% A + matrix(beta, k , k) %*% H); resvec=as.numeric(resmat); resmat=pmin(W, W %*% tcrossprod(H) - A %*% t(H) + eta2 * W); resvec=c(resvec, as.numeric(resmat)); conv=sum(abs(resvec)); #L1-norm convnum=sum(abs(resvec)>0); erravg=conv/convnum; # compute base average error if necessary if ( length(erravg1)==0 ) erravg1=erravg; if ( verbose && (i %% 1000==0) ){ # prints number of changing elements if( i==1000 ) cat("Track:\tIter\tInc\tchW\tchH\t---\terravg1\terravg\terravg/erravg1\n") cat(sprintf("\t%d\t%d\t%d\t%d\t---\terravg1: %.4e\terravg: %.4e\terravg/erravg1: %.4e\n", i,inc,changedW,changedH,erravg1,erravg,erravg/erravg1)); } #print(list(inc=inc, iconv=iconv, erravg=erravg, eps_conv=eps_conv, erravg1=erravg1)) if ( (inc>=iconv) && (erravg<=eps_conv*erravg1) ) break; idxWold=idxW; idxHold=idxH; } } if( verbose ) cat("--\n") # force to compute last error if not already done if( !is.null(x) ) x <- trackError(x, .snmf.objective(A, W, H, eta, beta), niter=i, force=TRUE) # transpose and reswap the roles if( !is.null(x) ){ if( version == 'L' ){ .basis(x) <- t(H) .coef(x) <- t(W) } else{ .basis(x) <- W .coef(x) <- H } # set number of iterations performed niter(x) <- i return(x) }else{ res <- list(W=W, H=H) if( version == 'L' ){ res$W <- t(H) res$H <- t(W) } return(invisible(res)) } } ###% Computes the objective value for the SNMF algorithm .snmf.objective <- function(target, w, h, eta, beta){ 1/2 * ( sum( (target - (w %*% h))^2 ) + eta * sum(w^2) + beta * sum( colSums( h )^2 ) ) } snmf.objective <- function(x, y, eta=-1, beta=0.01){ .snmf.objective(y, .basis(x), .coef(x), eta, beta) } ###% Wrapper function to use the SNMF/R algorithm with the NMF package. ###% .snmf <- function(target, seed, maxIter=20000L, eta=-1, beta=0.01, bi_conv=c(0, 10), eps_conv=1e-4, ...){ # retrieve the version of SNMF algorithm from its name: # it is defined by the last letter in the method's name (in upper case) name <- algorithm(seed) version <- toupper(substr(name, nchar(name), nchar(name))) # perform factorization using Kim and Park's algorithm ca <- match.call() ca[[1L]] <- as.name('nmf_snmf') # target ca[['A']] <- ca[['target']] ca[['target']] <- NULL # seed ca[['x']] <- ca[['seed']] ca[['seed']] <- NULL # version ca[['version']] <- version # verbose ca[['verbose']] <- verbose(seed) e <- parent.frame() sol <- eval(ca, envir=e) # nmf_snmf(target, seed, ..., version = version, verbose = verbose(seed)) # return solution return(sol) } #' NMF Algorithm - Sparse NMF via Alternating NNLS #' #' NMF algorithms proposed by \cite{KimH2007} that enforces sparsity #' constraint on the basis matrix (algorithm \sQuote{SNMF/L}) or the #' mixture coefficient matrix (algorithm \sQuote{SNMF/R}). #' #' The algorithm \sQuote{SNMF/R} solves the following NMF optimization problem on #' a given target matrix \eqn{A} of dimension \eqn{n \times p}{n x p}: #' \deqn{ #' \begin{array}{ll} #' & \min_{W,H} \frac{1}{2} \left(|| A - WH ||_F^2 + \eta ||W||_F^2 #' + \beta (\sum_{j=1}^p ||H_{.j}||_1^2)\right)\\ #' s.t. & W\geq 0, H\geq 0 #' \end{array} #' }{ #' min_{W,H} 1/2 (|| A - WH ||_F^2 + eta ||W||_F^2 #' + beta (sum_j ||H[,j]||_1^2)) #' #' s.t. W>=0, H>=0 #' } #' #' The algorithm \sQuote{SNMF/L} solves a similar problem on the transposed target matrix \eqn{A}, #' where \eqn{H} and \eqn{W} swap roles, i.e. with sparsity constraints applied to \code{W}. #' #' @param maxIter maximum number of iterations. #' @param eta parameter to suppress/bound the L2-norm of \code{W} and in #' \code{H} in \sQuote{SNMF/R} and \sQuote{SNMF/L} respectively. #' #' If \code{eta < 0}, then it is set to the maximum value in the target matrix is used. #' @param beta regularisation parameter for sparsity control, which #' balances the trade-off between the accuracy of the approximation and the #' sparseness of \code{H} and \code{W} in \sQuote{SNMF/R} and \sQuote{SNMF/L} respectively. #' #' Larger beta generates higher sparseness on \code{H} (resp. \code{W}). #' Too large beta is not recommended. #' @param bi_conv parameter of the biclustering convergence test. #' It must be a size 2 numeric vector \code{bi_conv=c(wminchange, iconv)}, #' with: #' \describe{ #' \item{\code{wminchange}:}{the minimal allowance of change in row-clusters.} #' \item{\code{iconv}:}{ decide convergence if row-clusters #' (within the allowance of \code{wminchange}) #' and column-clusters have not changed for \code{iconv} convergence checks.} #' } #' #' Convergence checks are performed every 5 iterations. #' @param eps_conv threshold for the KKT convergence test. #' @param ... extra argument not used. #' #' @rdname SNMF-nmf #' @aliases SNMF/R-nmf nmfAlgorithm.SNMF_R <- setNMFMethod('snmf/r', .snmf, objective=snmf.objective) #' @aliases SNMF/L-nmf #' @rdname SNMF-nmf nmfAlgorithm.SNMF_L <- setNMFMethod('snmf/l', .snmf, objective=snmf.objective) NMF/R/NMFStrategyOctave-class.R0000644000176000001440000001226012305630424015656 0ustar ripleyusers# S4 class for NMF strategies implemented in Octave/Matlab # Algorithms are run via RcppOctave # # Author: Renaud Gaujoux # Created: 23 Nov 2012 ########################################################### #' @include NMFStrategy-class.R NULL #' S4 Interface for Octave-Matlab NMF Algorithms #' #' This class implements the virtual interface \code{\linkS4class{NMFStrategy}} #' for NMF algorithms that are implemented in Octave/Matlab, and provided as #' a set of .m files or as plain code. #' #' The \code{run} method for this class runs the algorithms via the #' \code{\link[RcppOctave]{RcppOctave}} package. #' #' @slot algorithm character string that gives the name of the main Octave/Matlab #' function that implements the algorithm. #' The function must take at least two arguments: the target matrix and the initial #' NMF model, converted into an Octave list object, with elements corresponding to #' slots of the corresponding S4 class. #' @slot mcode character vector that contains a set of path to .m files. #' These files are (re-)sourced every time the strategy is called, and must be #' present at runtime in the current directory or in a directory from Octave path. #' setClass('NMFStrategyOctave' , representation( algorithm = '.functionSlot' # the function that implements the algorithm , mcode = 'character' , onReturn = 'function' # method called just before returning the resulting NMF object ) , prototype( onReturn = function(object, x){ if( !isNMFfit(object, recursive = FALSE) ){ if( !is.nmf(object) && !is.list(object) ){ stop("Result object should be an NMF object or a list") } fit(x) <- new2(modelname(x), object) if( !is.null(object$runtime) ) x@runtime <- structure(unlist(object$runtime), class='proc_time') } x } ) , contains = 'NMFStrategy' ) #' Runs the NMF algorithms implemented by the Octave/Matlab function associated with the #' strategy -- and stored in slot \code{'algorithm'} of \code{object}. #' #' This method is usually not called directly, but only via the function \code{\link{nmf}}, which #' takes care of many other details such as seeding the computation, handling RNG settings, #' or setting up parallel computations. #' #' @rdname NMFStrategy setMethod('run', signature(object='NMFStrategyOctave', y='matrix', x='NMFfit'), function(object, y, x, ...){ fstop <- function(...) stop("NMFStrategyOctave[", name(object), "]: ", ...) # first thing check for RcppOctave if( !require.quiet('RcppOctave', character.only=TRUE) ) fstop("The package RcppOctave is required to run this algorithm.\n" , " Try installing it with: install.packages('RcppOctave')") # add path to all mfiles mdirs <- character() ## add package mfiles directory if possible if( nzchar(pkg <- packageSlot(object)) ){ if( nzchar(pkg_mfiles <- RcppOctave::system.mfile(package=pkg)) ) mdirs <- c(mdirs, pkg_mfiles) } ## add path to specified mfiles mfiles <- object@mcode if( length(mfiles) && any(nzchar(mfiles)) ){ mfiles <- RcppOctave::as.mfile(mfiles) mdirs <- c(mdirs, dirname(mfiles)) } ## add to path if( length(mdirs) ){ mdirs <- unique(mdirs) # check which dirs were already in Octave path in_path <- sapply(mdirs, RcppOctave::o_inpath) sapply(mdirs[!in_path], RcppOctave::o_addpath) # on exit: cleanup Octave path on.exit({ rmpath <- RcppOctave::.O$rmpath sapply(mdirs[!in_path], rmpath) }) } # # load algorithm main <- algorithm(object, load=TRUE) # convert matrix storage mode if necessary if( storage.mode(y) != 'double' ){ storage.mode(y) <- 'double' } # call main function res <- main(y, x, ...) # wrap result object@onReturn(res, x) } ) #' Returns the name of the Octave/Matlab function that implements the NMF algorithm -- as stored in #' slot \code{algorithm}. #' #' @param load logical that indicates if the algorithm should be loaded as an #' R function. #' setMethod('algorithm', signature(object='NMFStrategyOctave'), function(object, load=FALSE){ f <- slot(object, 'algorithm') if( !load || is.function(f) ) return(f) if( !length(f) || !nchar(f) ) fstop("Main function is not defined for NMF algorithm '", name(object), "'.") # return wrapped into a function .main <- RcppOctave::o_get(f) function(y, x, ...){ .main(y, r=as.numeric(nbasis(x)), W=basis(x), H=coef(x), ...) } } ) #' Sets the name of the Octave/Matlab function that implements the NMF algorithm. #' It is stored in slot \code{algorithm}. setReplaceMethod('algorithm', signature(object='NMFStrategyOctave', value='character'), function(object, value){ slot(object, 'algorithm') <- head(value, 1L) object } ) #' @export #' @rdname NMFStrategyOctave-class setMethod('show', 'NMFStrategyOctave', function(object){ callNextMethod() f <- algorithm(object) cat(" main: " , if( is.function(f) ) str_fun(f) else str_c(f, ' ') , "\n", sep='') cat(" mcode: ", str_out(object@mcode, Inf), "\n", sep='') } ) NMF/R/nmf.R0000644000176000001440000032177612305630424012045 0ustar ripleyusers#' @include NMFstd-class.R #' @include NMFSet-class.R #' @include registry-seed.R #' @include registry-algorithms.R #' @include parallel.R NULL #' Running NMF algorithms #' #' @description #' The function \code{nmf} is a S4 generic defines the main interface to run NMF #' algorithms within the framework defined in package \code{NMF}. #' It has many methods that facilitates applying, developing and testing NMF #' algorithms. #' #' The package vignette \code{vignette('NMF')} contains an introduction to the #' interface, through a sample data analysis. #' #' @details #' #' The \code{nmf} function has multiple methods that compose a very flexible #' interface allowing to: #' \itemize{ #' \item combine NMF algorithms with seeding methods and/or stopping/convergence #' criterion at runtime; #' #' \item perform multiple NMF runs, which are computed in parallel whenever the host #' machine allows it; #' #' \item run multiple algorithms with a common set of parameters, ensuring a #' consistent environment (notably the RNG settings). #' } #' #' The workhorse method is \code{nmf,matrix,numeric,NMFStrategy}, which is eventually #' called by all other methods. #' The other methods provides convenient ways of specifying the NMF algorithm(s), #' the factorization rank, or the seed to be used. #' Some allow to directly run NMF algorithms on different types of objects, such #' as \code{data.frame} or \code{\link[Biobase]{ExpressionSet}} objects. #' #' @section Optimized C++ vs. plain R: #' Lee and Seung's multiplicative updates are used by several NMF algorithms. To improve #' speed and memory usage, a C++ implementation of the specific matrix products is used #' whenever possible. It directly computes the updates for each entry in the updated matrix, #' instead of using multiple standard matrix multiplication. #' #' The algorithms that benefit from this optimization are: 'brunet', 'lee', 'nsNMF' and 'offset'. % and 'lnmf' #' However there still exists plain R versions for these methods, which implement the updates #' as standard matrix products. These are accessible by adding the prefix '.R#' to their name: #' '.R#brunet', '.R#lee', '.R#nsNMF' and '.R#offset'. #' #' @param x target data to fit, i.e. a matrix-like object #' @param rank specification of the factorization rank. #' It is usually a single numeric value, but other type of values are possible #' (e.g. matrix), for which specific methods are implemented. #' See for example methods \code{nmf,matrix,matrix,ANY}. #' #' If \code{rank} is a numeric vector with more than one element, e.g. a range of ranks, #' then \code{\link{nmf}} performs the estimation procedure described in #' \code{\link{nmfEstimateRank}}. #' #' @param method specification of the NMF algorithm. #' The most common way of specifying the algorithm is to pass the access key #' (i.e. a character string) of an algorithm stored in the package's dedicated registry, #' but methods exists that handle other types of values, such as \code{function} or \code{list} #' object. See their descriptions in section \emph{Methods}. #' #' If \code{method} is missing the algorithm to use is obtained from the option #' \code{nmf.getOption('default.algorithm')}, unless it can be infer from the type of NMF model #' to fit, if this later is available from other arguments. #' Factory fresh default value is \sQuote{brunet}, which corresponds to the standard NMF #' algorithm from \cite{Brunet2004} (see section \emph{Algorithms}). #' #' Cases where the algorithm is inferred from the call are when an NMF model is passed in arguments \code{rank} #' or \code{seed} (see description for \code{nmf,matrix,numeric,NULL} in section \emph{Methods}). #' #' @param ... extra arguments to allow extension of the generic. #' Arguments that are not used in the chain of internal calls to \code{nmf} methods #' are passed to the function that effectively implements the algorithm that fits #' an NMF model on \code{x}. #' #' @export #' @inline #' #' @examples #' #' # Only basic calls are presented in this manpage. #' # Many more examples are provided in the demo file nmf.R #' \dontrun{ #' demo('nmf') #' } #' #' # random data #' x <- rmatrix(20,10) #' #' # run default algorithm with rank 2 #' res <- nmf(x, 2) #' #' # specify the algorithm #' res <- nmf(x, 2, 'lee') #' #' # get verbose message on what is going on #' res <- nmf(x, 2, .options='v') #' \dontrun{ #' # more messages #' res <- nmf(x, 2, .options='v2') #' # even more #' res <- nmf(x, 2, .options='v3') #' # and so on ... #' } #' #' @demo Using the main function nmf() #' #' # generate a synthetic dataset with known classes: 50 features, 23 samples (10+5+8) #' n <- 20; counts <- c(5, 3, 2); #' p <- sum(counts) #' x <- syntheticNMF(n, counts) #' dim(x) #' #' # build the true cluster membership #' groups <- unlist(mapply(rep, seq(counts), counts)) #' setGeneric('nmf', function(x, rank, method, ...) standardGeneric('nmf') ) #' Fits an NMF model on a \code{data.frame}. #' #' The target \code{data.frame} is coerced into a matrix with \code{\link{as.matrix}}. #' #' @demo #' #' # run on a data.frame #' res <- nmf(data.frame(x), 3) #' setMethod('nmf', signature(x='data.frame', rank='ANY', method='ANY'), function(x, rank, method, ...) { # replace missing values by NULL values for correct dispatch if( missing(method) ) method <- NULL if( missing(rank) ) rank <- NULL # apply NMF to the the data.frame converted into a matrix nmf(as.matrix(x), rank, method, ...) } ) #' Fits an NMF model using an appropriate algorithm when \code{method} is not supplied. #' #' This method tries to select an appropriate algorithm amongst the NMF algorithms #' stored in the internal algorithm registry, which contains the type of NMF models #' each algorithm can fit. #' This is possible when the type of NMF model to fit is available from argument \code{seed}, #' i.e. if it is an NMF model itself. #' Otherwise the algorithm to use is obtained from \code{nmf.getOption('default.algorithm')}. #' #' This method is provided for internal usage, when called from other \code{nmf} methods #' with argument \code{method} missing in the top call (e.g. \code{nmf,matrix,numeric,missing}). #' #' @demo #' #' # missing method: use algorithm suitable for seed #' res <- nmf(x, 2, seed=rnmf(2, x)) #' algorithm(res) #' res <- nmf(x, 2, seed=rnmf(2, x, model='NMFns')) #' algorithm(res) #' setMethod('nmf', signature(x='matrix', rank='numeric', method='NULL'), function(x, rank, method, seed=NULL, model=NULL, ...) { # a priori the default method will be used method <- nmf.getOption('default.algorithm') # use default seeding method if seed is missing if( is.null(seed) ){ # seed <- nmf.getOption('default.seed') }else{ # get reference object from which to infer model type refobj <- if( is.nmf(seed) ) seed else if( is.nmf(model) ) model if( !is.null(refobj) ){ mtype <- modelname(refobj) # try to find the algorithm suitable for the seed's NMF model method.potential <- selectNMFMethod(model=mtype, exact=TRUE, quiet=TRUE) if( is.null(method.potential) ) stop("NMF::nmf - Found no algorithm defined for model '", mtype, "'") if( length(method.potential) == 1 ) # only one to choose method <- method.potential else if( !is.element(method, method.potential) ){# several options, none is default method <- method.potential[1] warning("NMF::nmf - Selected algorithm '", method, "' to fit model '", mtype, "'." , "\n Alternatives are: " , str_out(method.potential[-1], Inf) , call.=FALSE, immediate.=TRUE) } } } nmf(x, rank, method, seed=seed, model=model, ...) } ) #' Fits multiple NMF models on a common matrix using a list of algorithms. #' #' The models are fitted sequentially with \code{nmf} using the same options #' and parameters for all algorithms. #' In particular, irrespective of the way the computation is seeded, this method #' ensures that all fits are performed using the same initial RNG settings. #' #' This method returns an object of class \code{\linkS4class{NMFList}}, that is #' essentially a list containing each fit. #' #' @param .parameters list of method-specific parameters. #' Its elements must have names matching a single method listed in \code{method}, #' and be lists of named values that are passed to the corresponding method. #' #' @demo #' # compare some NMF algorithms (tracking the approximation error) #' res <- nmf(x, 2, list('brunet', 'lee', 'nsNMF'), .options='t') #' res #' summary(res, class=groups) #' #' # plot the track of the residual errors #' plot(res) #' setMethod('nmf', signature(x='matrix', rank='numeric', method='list'), function(x, rank, method, ..., .parameters = list()) { # apply each NMF algorithm k <- 0 n <- length(method) # setup/check method specific parameters ARGS <- NULL .used.parameters <- character() if( !is.list(.parameters) ) stop("NMF::nmf - Invalid value for argument `.parameters`: must be a named list.") if( length(.parameters) && (is.null(names(.parameters)) || any(names(.parameters) == '')) ) stop("NMF::nmf - Invalid value for argument `.parameters`: all elements must be named.") t <- system.time({ res <- lapply(method, function(meth, ...){ k <<- k+1 methname <- if( isString(meth) ) meth else name(meth) cat("Compute NMF method '", methname, "' [", k, "/", n, "] ... ", sep='') # restore RNG on exit (except after last method) # => this ensures the methods use the same stochastic environment orng <- RNGseed() if( k < n ) on.exit( RNGseed(orng), add = TRUE) # look for method-specific arguments i.param <- 0L if( length(.parameters) ){ i.param <- charmatch(names(.parameters), methname) if( !length(i.param <- seq_along(.parameters)[!is.na(i.param)]) ) i.param <- 0L else if( length(i.param) > 1L ){ stop("Method name '", methname, "' matches multiple method-specific parameters " , "[", str_out(names(.parameters)[i.param], Inf), "]") } } #o <- capture.output( if( !i.param ){ res <- try( nmf(x, rank, meth, ...) , silent=TRUE) }else{ if( is.null(ARGS) ) ARGS <<- list(x, rank, ...) .used.parameters <<- c(.used.parameters, names(.parameters)[i.param]) res <- try( do.call(nmf, c(ARGS, method = meth, .parameters[[i.param]])) , silent=TRUE) } #) if( is(res, 'try-error') ) cat("ERROR\n") else cat("OK\n") return(res) } , ...) }) # filter out bad results ok <- sapply(res, function(x){ if( is(x, 'NMF.rank') ) all(sapply(x$fit, isNMFfit)) else isNMFfit(x) }) if( any(!ok) ){ # throw warning if some methods raised an error err <- lapply(which(!ok), function(i){ paste("'", method[[i]],"': ", res[[i]], sep='')}) warning("NMF::nmf - Incomplete results due to ", sum(!ok), " errors: \n- ", paste(err, collapse="- "), call.=FALSE) } res <- res[ok] # TODO error if ok is empty # not-used parameters if( length(.used.parameters) != length(.parameters) ){ warning("NMF::nmf - Did not use methods-specific parameters ", str_out(setdiff(names(.parameters), .used.parameters), Inf)) } # add names to the result list names(res) <- sapply(res, function(x){ if( is(x, 'NMF.rank') ) x <- x$fit[[1]] algorithm(x) }) # return list as is if surveying multiple ranks if( length(rank) > 1 ) return(res) # wrap the result in a NMFList object # DO NOT WRAP anymore here: NMFfitX objects are used only for results of multiple runs (single method) # the user can still join on the result if he wants to #res <- join(res, runtime=t) res <- new('NMFList', res, runtime=t) # return result return(res) } ) #' Fits an NMF model on \code{x} using an algorithm registered with access key #' \code{method}. #' #' Argument \code{method} is partially match against the access keys of all #' registered algorithms (case insensitive). #' Available algorithms are listed in section \emph{Algorithms} below or the #' introduction vignette. #' A vector of their names may be retrieved via \code{nmfAlgorithm()}. #' #' @section Algorithms: #' All algorithms are accessible by their respective access key as listed below. #' The following algorithms are available: #' \describe{ #' #' \item{\sQuote{brunet}}{ Standard NMF, based on the Kullback-Leibler divergence, #' from \cite{Brunet2004}. #' It uses simple multiplicative updates from \cite{Lee2001}, enhanced to avoid #' numerical underflow. #' #' Default stopping criterion: invariance of the connectivity matrix #' (see \code{\link{nmf.stop.connectivity}}). #' } #' #' \item{\sQuote{lee}}{ Standard NMF based on the Euclidean distance from \cite{Lee2001}. #' It uses simple multiplicative updates. #' #' Default stopping criterion: invariance of the connectivity matrix #' (see \code{\link{nmf.stop.connectivity}}). #' } #' #' \item{ls-nmf}{ Least-Square NMF from \cite{Wang2006}. #' It uses modified versions of Lee and Seung's multiplicative updates for the #' Euclidean distance, which incorporates weights on each entry of the target #' matrix, e.g. to reflect measurement uncertainty. #' #' Default stopping criterion: stationarity of the objective function #' (see \code{\link{nmf.stop.stationary}}). #' } #' #' \item{\sQuote{nsNMF}}{ Nonsmooth NMF from \cite{Pascual-Montano2006}. #' It uses a modified version of Lee and Seung's multiplicative updates for the #' Kullback-Leibler divergence \cite{Lee2001}, to fit a extension of the standard #' NMF model, that includes an intermediate smoothing matrix, meant meant to produce #' sparser factors. #' #' Default stopping criterion: invariance of the connectivity matrix #' (see \code{\link{nmf.stop.connectivity}}). #' } #' #' \item{\sQuote{offset}}{ NMF with offset from \cite{Badea2008}. #' It uses a modified version of Lee and Seung's multiplicative #' updates for Euclidean distance \cite{Lee2001}, to fit an NMF model that includes #' an intercept, meant to capture a common baseline and shared patterns, in #' order to produce cleaner basis components. #' #' Default stopping criterion: invariance of the connectivity matrix #' (see \code{\link{nmf.stop.connectivity}}). #' } #' #' \item{\sQuote{pe-nmf}}{ Pattern-Expression NMF from \emph{Zhang2008}. #' It uses multiplicative updates to minimize an objective function based on the #' Euclidean distance, that is regularized for effective expression of patterns #' with basis vectors. #' #' Default stopping criterion: stationarity of the objective function #' (see \code{\link{nmf.stop.stationary}}). #' } #' #' \item{\sQuote{snmf/r}, \sQuote{snmf/l}}{ Alternating Least Square (ALS) approach #' from \cite{KimH2007}. #' It applies the nonnegative least-squares algorithm from \cite{VanBenthem2004} #' (i.e. fast combinatorial nonnegative least-squares for multiple right-hand), #' to estimate the basis and coefficient matrices alternatively #' (see \code{\link{fcnnls}}). #' It minimises an Euclidean-based objective function, that is regularized to #' favour sparse basis matrices (for \sQuote{snmf/l}) or sparse coefficient matrices #' (for \sQuote{snmf/r}). #' #' Stopping criterion: built-in within the internal workhorse function \code{nmf_snmf}, #' based on the KKT optimality conditions. #' } #' #' } #' #' @section Seeding methods: #' The purpose of seeding methods is to compute initial values for the factor #' matrices in a given NMF model. #' This initial guess will be used as a starting point by the chosen NMF algorithm. #' #' The seeding method to use in combination with the algorithm can be passed #' to interface \code{nmf} through argument \code{seed}. #' The seeding seeding methods available in registry are listed by the function #' \code{\link{nmfSeed}} (see list therein). #' #' Detailed examples of how to specify the seeding method and its parameters can #' be found in the \emph{Examples} section of this man page and in the package's #' vignette. #' #' @seealso \code{\link{nmfAlgorithm}} #' #' @demo #' #' # specify algorithm by its name #' res <- nmf(x, 3, 'nsNMF', seed=123) # nonsmooth NMF #' # names are partially matched so this also works #' identical(res, nmf(x, 3, 'ns', seed=123)) #' #' res <- nmf(x, 3, 'offset') # NMF with offset #' #' setMethod('nmf', signature(x='matrix', rank='numeric', method='character'), function(x, rank, method, ...) { # if there is more than one methods then treat the vector as a list if( length(method) > 1 ){ return( nmf(x, rank, as.list(method), ...) ) } # create the NMFStrategy from its name strategy <- nmfAlgorithm(method) # apply nmf using the retrieved strategy nmf(x, rank, method=strategy, ...) } ) #' Fits an NMF model on \code{x} using a custom algorithm defined the function #' \code{method}. #' #' The supplied function must have signature \code{(x=matrix, start=NMF, ...)} #' and return an object that inherits from class \code{\linkS4class{NMF}}. #' It will be called internally by the workhorse \code{nmf} method, with an NMF model #' to be used as a starting point passed in its argument \code{start}. #' #' Extra arguments in \code{...} are passed to \code{method} from the top #' \code{nmf} call. #' Extra arguments that have no default value in the definition of the function #' \code{method} are required to run the algorithm (e.g. see argument \code{alpha} #' of \code{myfun} in the examples). #' #' If the algorithm requires a specific type of NMF model, this can be specified #' in argument \code{model} that is handled as in the workhorse \code{nmf} #' method (see description for this argument). #' #' @param name name associated with the NMF algorithm implemented by the function #' \code{method} [only used when \code{method} is a function]. #' @param objective specification of the objective function associated with the #' algorithm implemented by the function \code{method} #' [only used when \code{method} is a function]. #' #' It may be either \code{'euclidean'} or \code{'KL'} for specifying the euclidean #' distance (Frobenius norm) or the Kullback-Leibler divergence respectively, #' or a function with signature \code{(x="NMF", y="matrix", ...)} that computes #' the objective value for an NMF model \code{x} on a target matrix \code{y}, #' i.e. the residuals between the target matrix and its NMF estimate. #' Any extra argument may be specified, e.g. \code{function(x, y, alpha, beta=2, ...)}. #' #' @param mixed a logical that indicates if the algorithm implemented by the function #' \code{method} support mixed-sign target matrices, i.e. that may contain negative #' values [only used when \code{method} is a function]. #' #' @demo #' #' # run a custom algorithm defined as a standard function #' myfun <- function(x, start, alpha){ #' # update starting point #' # ... #' basis(start) <- 3 * basis(start) #' # return updated point #' start #' } #' #' res <- nmf(x, 2, myfun, alpha=3) #' algorithm(res) #' # error: alpha missing #' try( nmf(x, 2, myfun) ) #' #' # possibly the algorithm fits a non-standard NMF model, e.g. NMFns model #' res <- nmf(x, 2, myfun, alpha=3, model='NMFns') #' modelname(res) #' setMethod('nmf', signature(x='matrix', rank='numeric', method='function'), function(x, rank, method, seed, model='NMFstd', ..., name, objective='euclidean', mixed=FALSE){ model_was_a_list <- is.list(model) if( is.character(model) ) model <- list(model=model) if( !is.list(model) ){ stop("nmf - Invalid argument `model`: must be NULL or a named list of initial values for slots in an NMF model.") } # arguments passed to the call to NMFStrategyFunction strat <- list('NMFStrategyFunction' , algorithm = method , objective = objective , mixed = mixed[1] ) ## Determine type of NMF model associated with the NMFStrategy # All elements of `model` (except the model class) will be passed to # argument `model` of the workhorse `nmf` method, which will use them # to create the NMF model in a call to `nmfModel` if( length(model) > 0L ){ if( !is.null(model$model) ){ strat$model <- model$model model$model <- NULL }else if( isNMFclass(model[[1]]) ){ strat$model <- model[[1]] # use the remaining elements to instanciate the NMF model model <- model[-1] } # all elements must be named if( !hasNames(model, all=TRUE) ){ stop("NMF::nmf - Invalid argument `model`: all elements must be named, except the first one which must then be an NMF model class name") } } ## # if name is missing: generate a temporary unique name if( missing(name) ) name <- basename(tempfile("nmf_")) # check that the name is not a registered name if( existsNMFMethod(name) ) stop("Invalid name for custom NMF algorithm: '",name,"' is already a registered NMF algorithm") strat$name <- name # create NMFStrategy strategy <- do.call('new', strat) # full validation of the strategy validObject(strategy, complete=TRUE) if( missing(seed) ) seed <- NULL if( !model_was_a_list && length(model) == 0L ) model <- NULL # call method 'nmf' with the new object nmf(x, rank, strategy, seed=seed, model=model, ...) } ) #' Fits an NMF model using the NMF model \code{rank} to seed the computation, #' i.e. as a starting point. #' #' This method is provided for convenience as a shortcut for #' \code{nmf(x, nbasis(object), method, seed=object, ...)} #' It discards any value passed in argument \code{seed} and uses the NMF model passed #' in \code{rank} instead. #' It throws a warning if argument \code{seed} not missing. #' #' If \code{method} is missing, this method will call the method #' \code{nmf,matrix,numeric,NULL}, which will infer an algorithm suitable for fitting an #' NMF model of the class of \code{rank}. #' #' @demo #' #' # assume a known NMF model compatible with the matrix `x` #' y <- rnmf(3, x) #' # fits an NMF model (with default method) on some data using y as a starting point #' res <- nmf(x, y) #' # the fit can be reproduced using the same starting point #' nmf.equal(nmf(x, y), res) #' setMethod('nmf', signature(x='matrix', rank='NMF', method='ANY'), function(x, rank, method, seed, ...){ if( !missing(seed) ){ if( isNumber(seed) ){ set.seed(seed) }else if( !is.null(seed) ){ warning("NMF::nmf - Discarding value of argument `seed`: directly using NMF model supplied in `rank` instead.\n" , " If seeding is necessary, please use argument `model` pass initial model slots, which will be filled by the seeding method.") } # # pass the model via a one-off global variable # .nmf_InitModel(rank) } # replace missing method by NULL for correct dispatch if( missing(method) ) method <- NULL nmf(x, nbasis(rank), method, seed=rank, ...) } ) .nmf_InitModel <- oneoffVariable() #' Fits an NMF model using the NMF model supplied in \code{seed}, to seed the computation, #' i.e. as a starting point. #' #' This method is provided for completeness and is equivalent to #' \code{nmf(x, seed, method, ...)}. #' setMethod('nmf', signature(x='matrix', rank='NULL', method='ANY'), function(x, rank, method, seed, ...){ if( missing(seed) || !is.nmf(seed) ) stop("NMF::nmf - Argument `seed` must be an NMF model when argument `rank` is missing.") # replace missing method by NULL for correct dispatch if( missing(method) ) method <- NULL nmf(x, nbasis(seed), method, seed=seed, ...) } ) #' Method defined to ensure the correct dispatch to workhorse methods in case #' of argument \code{rank} is missing. setMethod('nmf', signature(x='matrix', rank='missing', method='ANY'), function(x, rank, method, ...){ # replace missing method by NULL for correct dispatch if( missing(method) ) method <- NULL nmf(x, NULL, method, ...) } ) #' Method defined to ensure the correct dispatch to workhorse methods in case #' of argument \code{method} is missing. #' #' @demo #' # missing method: use default algorithm #' res <- nmf(x, 3) #' setMethod('nmf', signature(x='matrix', rank='numeric', method='missing'), function(x, rank, method, ...){ nmf(x, rank, NULL, ...) } ) #' Fits an NMF model partially seeding the computation with a given matrix passed #' in \code{rank}. #' #' The matrix \code{rank} is used either as initial value for the basis or mixture #' coefficient matrix, depending on its dimension. #' #' Currently, such partial NMF model is directly used as a seed, meaning that #' the remaining part is left uninitialised, which is not accepted by all NMF algorithm. #' This should change in the future, where the missing part of the model will be #' drawn from some random distribution. #' #' Amongst built-in algorithms, only \sQuote{snmf/l} and \sQuote{snmf/r} support #' partial seeds, with only the coefficient or basis matrix initialised #' respectively. #' #' @demo #' #' # Fit a 3-rank model providing an initial value for the basis matrix #' nmf(x, rmatrix(nrow(x), 3), 'snmf/r') #' #' # Fit a 3-rank model providing an initial value for the mixture coefficient matrix #' nmf(x, rmatrix(3, ncol(x)), 'snmf/l') #' setMethod('nmf', signature(x='matrix', rank='matrix', method='ANY'), function(x, rank, method, seed, model=list(), ...) { if( is.character(model) ) model <- list(model=model) if( !is.list(model) ) stop("nmf - Invalid argument `model`: must be NULL or a named list of initial values for slots in an NMF object.") if( !hasNames(model, all=TRUE) ) stop("nmf - Invalid argument `model`: all elements must be named") # remove rank specification if necessary if( !is.null(model$rank) ){ warning("nmf - Discarding rank specification in argument `model`: use value inferred from matrix supplied in argument `rank`") model$rank <- NULL } # check compatibility of dimensions newseed <- if( nrow(rank) == nrow(x) ){ # rank is the initial value for the basis vectors if( length(model)==0L ) nmfModel(W=rank) else{ model$W <- rank do.call('nmfModel', model) } }else if( ncol(rank) == ncol(x) ){ # rank is the initial value for the mixture coefficients if( length(model)==0L ) nmfModel(H=rank) else{ model$H <- rank do.call('nmfModel', model) } }else stop("nmf - Invalid argument `rank`: matrix dimensions [",str_out(dim(x),sep=' x '),"]" , " are incompatible with the target matrix [", str_out(dim(x),sep=' x '),"].\n" , " When `rank` is a matrix it must have the same number of rows or columns as the target matrix `x`.") # replace missing values by NULL values for correct dispatch if( missing(method) ) method <- NULL if( missing(seed) ) seed <- NULL #nmf(x, nbasis(newseed), method, seed=seed, model=newseed, ...) nmf(x, newseed, method, seed=seed, ...) } ) #' Shortcut for \code{nmf(x, as.matrix(rank), method, ...)}. setMethod('nmf', signature(x='matrix', rank='data.frame', method='ANY'), function(x, rank, method, ...){ # replace missing values by NULL values for correct dispatch if( missing(method) ) method <- NULL nmf(x, as.matrix(rank), method, ...) } ) #' This method implements the interface for fitting formula-based NMF models. #' See \code{\link{nmfModel}}. #' #' Argument \code{rank} target matrix or formula environment. #' If not missing, \code{model} must be a \code{list}, a \code{data.frame} or #' an \code{environment} in which formula variables are searched for. #' setMethod('nmf', signature(x='formula', rank='ANY', method='ANY'), function(x, rank, method, ..., model=NULL){ # replace missing values by NULL values for correct dispatch if( missing(method) ) method <- NULL if( missing(rank) ) rank <- NULL # if multiple numeric rank: use nmfRestimateRank if( is.vector(rank) && is.numeric(rank) ){ if( length(rank) > 1L ){ return( nmfEstimateRank(x, rank, method, ..., model=model) ) } } # build formula based model model <- nmfModel(x, rank, data=model) nmf(attr(model, 'target'), nbasis(model), method, ..., model=model) } ) .as.numeric <- function(x){ suppressWarnings( as.numeric(x) ) } .translate.string <- function(string, dict){ res <- list() dict <- as.list(dict) if( nchar(string) == 0 ) return(res) opt.val <- TRUE last.key <- NULL buffer <- '' lapply(strsplit(string, '')[[1]], function(c){ if( c=='-' ) opt.val <<- FALSE else if( c=='+' ) opt.val <<- TRUE else if( opt.val && !is.na(.as.numeric(c)) ) buffer <<- paste(buffer, c, sep='') else if( !is.null(dict[[c]]) ){ # flush the buffer into the last key if necessary if( nchar(buffer) > 0 && !is.null(last.key) && !is.na(buffer <- .as.numeric(buffer)) ){ res[[dict[[last.key]]]] <<- buffer buffer <<- '' } res[[dict[[c]]]] <<- opt.val last.key <<- c } } ) # flush the buffer into the last key if( nchar(buffer) > 0 && !is.null(last.key) && !is.na(buffer <- .as.numeric(buffer)) ) res[[dict[[last.key]]]] <- buffer # return result return(res) } #' Error Checks in NMF Runs #' #' Auxiliary function for internal error checks in nmf results. #' #' @param object a list of lists #' @param element name of an element of the inner lists #' #' @keywords internal checkErrors <- function(object, element=NULL){ # extract error messages errors <- if( is.null(element) ){ lapply(seq_along(object), function(i){ x <- object[[i]] if( is(x, 'error') ) c(i, x) else NA }) }else{ lapply(seq_along(object), function(i){ x <- object[[i]][[element, exact=TRUE]] if( is(x, 'error') ) c(i, x) else NA }) } errors <- errors[!is.na(errors)] nerrors <- length(errors) res <- list(n = nerrors) # format messages if( nerrors ){ ierrors <- sapply(errors, '[[', 1L) msg <- sapply(errors, '[[', 2L) ierrors_unique <- ierrors[!duplicated(msg)] res$msg <- str_c(" - ", str_c("run #", ierrors_unique, ': ', msg[ierrors_unique], collapse="\n - ")) } # return error data res } ###% Performs NMF on a matrix using a given NMF method. ###% ###% This method is the entry point for NMF. It is eventually called by any definition of the \code{nmf} function. #' @param seed specification of the starting point or seeding method, which will #' compute a starting point, usually using data from the target matrix in order to #' provide a good guess. #' #' The seeding method may be specified in the following way: #' #' \describe{ #' #' \item{a \code{character} string:}{ giving the name of a \emph{registered} #' seeding method. The corresponding method will be called to compute #' the starting point. #' #' Available methods can be listed via \code{nmfSeed()}. #' See its dedicated documentation for details on each available registered methods #' (\code{\link{nmfSeed}}). #' } #' #' \item{a \code{list}:}{ giving the name of a \emph{registered} #' seeding method and, optionally, extra parameters to pass to it.} #' #' \item{a single \code{numeric}:}{ that is used to seed the random number #' generator, before generating a random starting point. #' #' Note that when performing multiple runs, the L'Ecuyer's RNG is used in order to #' produce a sequence of random streams, that is used in way that ensures #' that parallel computation are fully reproducible. #' } #' #' \item{an object that inherits from \code{\linkS4class{NMF}}:}{ it should #' contain the data of an initialised NMF model, i.e. it must contain valid #' basis and mixture coefficient matrices, directly usable by the algorithm's #' workhorse function.} #' #' \item{a \code{function}:}{ that computes the starting point. It must have #' signature \code{(object="NMF", target="matrix", ...)} and return an object that #' inherits from class \code{NMF}. #' It is recommended to use argument \code{object} as a template for the returned object, #' by only updating the basis and coefficient matrices, using \code{\link{basis<-}} and #' \code{\link{coef<-}} respectively. #' } #' #' } #' #' @param rng rng specification for the run(s). #' This argument should be used to set the the RNG seed, while still specifying the seeding #' method argument \var{seed}. #' #' @param model specification of the type of NMF model to use. #' #' It is used to instantiate the object that inherits from class \code{\linkS4class{NMF}}, #' that will be passed to the seeding method. #' The following values are supported: #' \itemize{ #' #' \item \code{NULL}, the default model associated to the NMF algorithm is #' instantiated and \code{...} is looked-up for arguments with names that #' correspond to slots in the model class, which are passed to the function #' \code{\link{nmfModel}} to instantiate the model. #' Arguments in \code{...} that do not correspond to slots are passed to the #' algorithm. #' #' \item a single \code{character} string, that is the name of the NMF model #' class to be instantiate. #' In this case, arguments in \code{...} are handled in the same way as #' when \code{model} is \code{NULL}. #' #' \item a \code{list} that contains named values that are passed to the #' function \code{\link{nmfModel}} to instantiate the model. #' In this case, \code{...} is not looked-up at all, and passed entirely to #' the algorithm. #' This means that all necessary model parameters must be specified in #' \code{model}. #' #' } #' #' \strong{Argument/slot conflicts:} #' In the case a parameter of the algorithm has the same name as a model slot, #' then \code{model} MUST be a list -- possibly empty --, if one wants this #' parameter to be effectively passed to the algorithm. #' #' If a variable appears in both arguments \code{model} and \code{\dots}, #' the former will be used to initialise the NMF model, the latter will be #' passed to the NMF algorithm. #' See code examples for an illustration of this situation. #' #' @param nrun number of runs to perform. #' It specifies the number of runs to perform. #' By default only one run is performed, except if \code{rank} is a numeric vector #' with more than one element, in which case a default of 30 runs per value of the #' rank are performed, allowing the computation of a consensus matrix that is used #' in selecting the appropriate rank (see \code{\link{consensus}}). #' #' When using a random seeding method, multiple runs are generally required to #' achieve stability and avoid \emph{bad} local minima. #' #' @param .options this argument is used to set runtime options. #' #' It can be a \code{list} containing named options with their values, or, in #' the case only boolean/integer options need to be set, a character string #' that specifies which options are turned on/off or their value, in a unix-like #' command line argument way. #' #' The string must be composed of characters that correspond to a given option #' (see mapping below), and modifiers '+' and '-' that toggle options on and off respectively. #' E.g. \code{.options='tv'} will toggle on options \code{track} and \code{verbose}, #' while \code{.options='t-v'} will toggle on option \code{track} and toggle off #' option \code{verbose}. #' #' Modifiers '+' and '-' apply to all option character found after them: #' \code{t-vp+k} means \code{track=TRUE}, \code{verbose=parallel=FALSE}, #' and \code{keep.all=TRUE}. #' The default behaviour is to assume that \code{.options} starts with a '+'. #' #' for options that accept integer values, the value may be appended to the #' option's character e.g. \code{'p4'} for asking for 4 processors or \code{'v3'} #' for showing verbosity message up to level 3. #' #' The following options are available (the characters after \dQuote{-} are those #' to use to encode \code{.options} as a string): #' \describe{ #' #' \item{debug - d}{ Toggle debug mode (default: \code{FALSE}). #' Like option \code{verbose} but with more information displayed.} #' #' \item{keep.all - k}{ used when performing multiple runs (\code{nrun}>1): if #' \code{TRUE}, all factorizations are saved and returned (default: \code{FALSE}). #' Otherwise only the factorization achieving the minimum residuals is returned.} #' #' \item{parallel - p}{ this option is useful on multicore *nix or Mac machine #' only, when performing multiple runs (\code{nrun} > 1) (default: \code{TRUE}). #' If \code{TRUE}, the runs are performed using the parallel foreach backend #' defined in argument \code{.pbackend}. #' If this is set to \code{'mc'} or \code{'par'} then \code{nmf} tries to #' perform the runs using multiple cores with package #' \code{link[doParallel]{doParallel}} -- which therefore needs to be installed. #' #' If equal to an integer, then \code{nmf} tries to perform the computation on #' the specified number of processors. #' When passing options as a string the number is appended to the option's character #' e.g. \code{'p4'} for asking for 4 processors. #' #' If \code{FALSE}, then the computation is performed sequentially using the base #' function \code{\link{sapply}}. #' #' Unlike option 'P' (capital 'P'), if the computation cannot be performed in #' parallel, then it will still be carried on sequentially. #' #' \strong{IMPORTANT NOTE FOR MAC OS X USERS:} The parallel computation is #' based on the \code{doMC} and \code{multicore} packages, so the same care #' should be taken as stated in the vignette of \code{doMC}: \emph{\dQuote{it #' is not safe to use doMC from R.app on Mac OS X. Instead, you should use doMC #' from a terminal session, starting R from the command line.}} } #' #' \item{parallel.required - P}{ Same as \code{p}, but an error is thrown if #' the computation cannot be performed in parallel or with the specified number #' of processors.} #' #' \item{shared.memory - m}{ toggle usage of shared memory (requires the #' \pkg{synchronicity} package). #' Default is as defined by \code{nmf.getOption('shared.memory')}.} #' #' \item{restore.seed - r}{ deprecated option since version 0.5.99. #' Will throw a warning if used.} #' #' \item{simplifyCB - S}{ toggle simplification of the callback results. #' Default is \code{TRUE}} #' #' \item{track - t}{ enables error tracking (default: FALSE). #' If \code{TRUE}, the returned object's slot \code{residuals} contains the #' trajectory of the objective values, which can be retrieved via #' \code{residuals(res, track=TRUE)} #' This tracking functionality is available for all built-in algorithms. #' } #' #' \item{verbose - v}{ Toggle verbosity (default: \code{FALSE}). #' If \code{TRUE}, messages about the configuration and the state of the #' current run(s) are displayed. #' The level of verbosity may be specified with an integer value, the greater #' the level the more messages are displayed. #' Value \code{FALSE} means no messages are displayed, while value \code{TRUE} #' is equivalent to verbosity level 1. #' } #' #' } #' #' @param .pbackend specification of the \code{\link{foreach}} parallel backend #' to register and/or use when running in parallel mode. #' See options \code{p} and \code{P} in argument \code{.options} for how to #' enable this mode. #' Note that any backend that is internally registered is cleaned-up on exit, #' so that the calling foreach environment should not be affected by a call to #' \code{nmf} -- except when \code{.pbackend=NULL}. #' #' Currently it accepts the following values: #' \describe{ #' #' \item{\sQuote{par}}{ use the backend(s) defined by the package #' \code{\link{doParallel}};} #' \item{a numeric value}{ use the specified number of cores with \code{doParallel} #' backend;} #' \item{\sQuote{seq}}{ use the foreach sequential backend \code{doSEQ};} #' \item{\code{NULL}}{ use currently registered backend;} #' \item{\code{NA}}{ do not compute using a foreach loop -- and therefore not in #' parallel -- but rather use a call to standard \code{\link{sapply}}. #' This is useful for when developing/debugging NMF algorithms, as foreach loop #' handling may sometime get in the way. #' #' Note that this is equivalent to using \code{.options='-p'} or \code{.options='p0'}, #' but takes precedence over any option specified in \code{.options}: #' e.g. \code{nmf(..., .options='P10', .pbackend=NA)} performs all runs sequentially #' using \code{sapply}. #' Use \code{nmf.options(pbackend=NA)} to completely disable foreach/parallel computations #' for all subsequent \code{nmf} calls.} #' #' \item{\sQuote{mc}}{ identical to \sQuote{par} and defined to ensure backward #' compatibility.} #' } #' #' @param .callback Used when option \code{keep.all=FALSE} (default). It #' allows to pass a callback function that is called after each run when #' performing multiple runs (i.e. with \code{nrun>1}). #' This is useful for example if one is also interested in saving summary #' measures or process the result of each NMF fit before it gets discarded. #' After each run, the callback function is called with two arguments, the #' \code{\linkS4class{NMFfit}} object that as just been fitted and the run #' number: \code{.callback(res, i)}. #' For convenience, a function that takes only one argument or has #' signature \code{(x, ...)} can still be passed in \code{.callback}. #' It is wrapped internally into a dummy function with two arguments, #' only the first of which is passed to the actual callback function (see example #' with \code{summary}). #' #' The call is wrapped into a tryCatch so that callback errors do not stop the #' whole computation (see below). #' #' The results of the different calls to the callback function are stored in a #' miscellaneous slot accessible using the method \code{$} for \code{NMFfit} #' objects: \code{res$.callback}. #' By default \code{nmf} tries to simplify the list of callback result using #' \code{sapply}, unless option \code{'simplifyCB'} is \code{FASE}. #' #' If no error occurs \code{res$.callback} contains the list of values that #' resulted from the calling the callback function --, ordered as the fits. #' If any error occurs in one of the callback calls, then the whole computation is #' \strong{not} stopped, but the error message is stored in \code{res$.callback}, #' in place of the result. #' #' See the examples for sample code. #' #' @return The returned value depends on the run mode: #' #' \item{Single run:}{An object of class \code{\linkS4class{NMFfit}}.} #' #' \item{Multiple runs, single method:}{When \code{nrun > 1} and \code{method} #' is not \code{list}, this method returns an object of class \code{\linkS4class{NMFfitX}}.} #' #' \item{Multiple runs, multiple methods:}{When \code{nrun > 1} and \code{method} #' is a \code{list}, this method returns an object of class \code{\linkS4class{NMFList}}.} #' #' @demo #' #' # default fit #' res <- nmf(x, 2) #' summary(res, class=groups) #' #' # run default algorithm multiple times (only keep the best fit) #' res <- nmf(x, 3, nrun=10) #' res #' summary(res, class=groups) #' #' # run default algorithm multiple times keeping all the fits #' res <- nmf(x, 3, nrun=10, .options='k') #' res #' summary(res, class=groups) #' #' ## Note: one could have equivalently done #' # res <- nmf(V, 3, nrun=10, .options=list(keep.all=TRUE)) #' #' # use a method that fit different model #' res <- nmf(x, 2, 'nsNMF') #' fit(res) #' #' # pass parameter theta to the model via `...` #' res <- nmf(x, 2, 'nsNMF', theta=0.2) #' fit(res) #' #' ## handling arguments in `...` and model parameters #' myfun <- function(x, start, theta=100){ cat("theta in myfun=", theta, "\n\n"); start } #' # no conflict: default theta #' fit( nmf(x, 2, myfun) ) #' # no conlfict: theta is passed to the algorithm #' fit( nmf(x, 2, myfun, theta=1) ) #' # conflict: theta is used as model parameter #' fit( nmf(x, 2, myfun, model='NMFns', theta=0.1) ) #' # conflict solved: can pass different theta to model and algorithm #' fit( nmf(x, 2, myfun, model=list('NMFns', theta=0.1), theta=5) ) #' #' ## USING SEEDING METHODS #' #' # run default algorithm with the Non-negative Double SVD seeding method ('nndsvd') #' res <- nmf(x, 3, seed='nndsvd') #' #' ## Note: partial match also works #' identical(res, nmf(x, 3, seed='nn')) #' #' # run nsNMF algorithm, fixing the seed of the random number generator #' res <- nmf(x, 3, 'nsNMF', seed=123456) #' nmf.equal(nmf(x, 3, 'nsNMF', seed=123456), res) #' #' # run default algorithm specifying the starting point following the NMF standard model #' start.std <- nmfModel(W=matrix(0.5, n, 3), H=matrix(0.2, 3, p)) #' nmf(x, start.std) #' #' # to run nsNMF algorithm with an explicit starting point, this one #' # needs to follow the 'NMFns' model: #' start.ns <- nmfModel(model='NMFns', W=matrix(0.5, n, 3), H=matrix(0.2, 3, p)) #' nmf(x, start.ns) #' # Note: the method name does not need to be specified as it is infered from the #' # when there is only one algorithm defined for the model. #' #' # if the model is not appropriate (as defined by the algorihtm) an error is thrown #' # [cf. the standard model doesn't include a smoothing parameter used in nsNMF] #' try( nmf(x, start.std, method='nsNMF') ) #' #' ## Callback functions #' # Pass a callback function to only save summary measure of each run #' res <- nmf(x, 3, nrun=3, .callback=summary) #' # the callback results are simplified into a matrix #' res$.callback #' res <- nmf(x, 3, nrun=3, .callback=summary, .opt='-S') #' # the callback results are simplified into a matrix #' res$.callback #' #' # Pass a custom callback function #' cb <- function(obj, i){ if( i %% 2 ) sparseness(obj) >= 0.5 } #' res <- nmf(x, 3, nrun=3, .callback=cb) #' res$.callback #' #' # Passs a callback function which throws an error #' cb <- function(){ i<-0; function(object){ i <<- i+1; if( i == 1 ) stop('SOME BIG ERROR'); summary(object) }} #' res <- nmf(x, 3, nrun=3, .callback=cb()) #' #' ## PARALLEL COMPUTATIONS #' # try using 3 cores, but use sequential if not possible #' res <- nmf(x, 3, nrun=3, .options='p3') #' #' # force using 3 cores, error if not possible #' res <- nmf(x, 3, nrun=3, .options='P3') #' #' # use externally defined cluster #' library(parallel) #' cl <- makeCluster(6) #' res <- nmf(x, 3, nrun=3, .pbackend=cl) #' #' # use externally registered backend #' registerDoParallel(cl) #' res <- nmf(x, 3, nrun=3, .pbackend=NULL) #' setMethod('nmf', signature(x='matrix', rank='numeric', method='NMFStrategy'), #function(x, rank, method, seed='random', nrun=1, keep.all=FALSE, optimized=TRUE, init='NMF', track, verbose, ...) function(x, rank, method , seed=nmf.getOption('default.seed'), rng = NULL , nrun=if( length(rank) > 1L ) 30 else 1, model=NULL, .options=list() , .pbackend=nmf.getOption('pbackend') , .callback=NULL #callback function called after a run , ...) { fwarning <- function(...) nmf_warning('nmf', ...) fstop <- function(...) nmf_stop('nmf', ...) # if options are given as a character string, translate it into a list of booleans if( is.character(.options) ){ .options <- .translate.string(.options, c(t='track', v='verbose', d='debug' , p='parallel', P='parallel.required' , k='keep.all', r='restore.seed', f='dry.run' , g='garbage.collect' , c='cleanup', S='simplifyCB' , R='RNGstream', m='shared.memory')) } # get seeding method from the strategy's defaults if needed seed <- defaultArgument(seed, method, nmf.getOption('default.seed'), force=is.null(seed)) .method_defaults <- method@defaults .method_defaults$seed <- NULL # # RNG specification if( isRNGseed(seed) ){ if( !is.null(rng) ) warning("Discarding RNG specification in argument `rng`: using those passed in argument `seed`.") rng <- seed seed <- 'random' } # # setup verbosity options debug <- if( !is.null(.options$debug) ) .options$debug else nmf.getOption('debug') verbose <- if( debug ) Inf else if( !is.null(.options$verbose) ) .options$verbose else nmf.getOption('verbose') # show call in debug mode if( debug ){ .ca <- match.call() message('# NMF call: ', paste(capture.output(print(.ca)), collapse="\n ")) } # nmf over a range of values: pass the call to nmfEstimateRank if( length(rank) > 1 ){ if( verbose <= 1 ) .options$verbose <- FALSE return( nmfEstimateRank(x, range = rank, method = method, nrun = nrun , seed = seed, rng = rng, model = model , .pbackend = .pbackend, .callback = .callback , verbose=verbose, .options=.options, ...) ) } .OPTIONS <- list() # cleanup on exit .CLEANUP <- .options$cleanup %||% TRUE # tracking of objective value .OPTIONS$track <- if( !is.null(.options$track) ) .options$track else nmf.getOption('track') # dry run dry.run <- .options$dry.run %||% FALSE # call the garbage collector regularly opt.gc <- if( !is.null(.options$garbage.collect) ) .options$garbage.collect else nmf.getOption('gc') if( is.logical(opt.gc) && opt.gc ) opt.gc <- ceiling(max(nrun,50) / 3) .options$garbage.collect <- opt.gc # keep results from all runs? keep.all <- .options$keep.all %||% FALSE # shared memory? shared.memory <- if( !is.null(.options$shared.memory) ) .options$shared.memory else nmf.getOption('shared.memory') # use RNG stream .options$RNGstream <- .options$RNGstream %||% TRUE # discard .callback when not used if( is.function(.callback) ){ w <- if( nrun==1 ) "discarding argument `.callback`: not used when `nrun=1`." else if( keep.all ) "discarding argument `.callback`: not used when option `keep.all=TRUE`." if( !is.null(w) ){ .callback <- NULL fwarning(w, immediate.=TRUE) } # wrap into another function if necessary if( is.function(.callback) ){ # default is to simplify .options$simplifyCB <- .options$simplifyCB %||% TRUE args <- formals(.callback) if( length(args) <= 2L ){ if( length(args) < 2L || '...' %in% names(args) ){ .CALLBACK <- .callback .callback <- function(object, i) .CALLBACK(object) } } # define post-processing function processCallback <- function(res){ # check errors errors <- checkErrors(res, '.callback') if( errors$n > 0 ){ fwarning("All NMF fits were successful but ", errors$n, "/", nrun, " callback call(s) threw an error.\n" ,"# ", if(errors$n>10) "First 10 c" else "C", "allback error(s) thrown:\n" , errors$msg ) } # add callback values to result list sapply(res, '[[', '.callback' , simplify=.options$simplifyCB && errors$n == 0L) } } } ## ROLLBACK PROCEDURE exitSuccess <- exitCheck() on.exit({ if( verbose > 1 ) message("# NMF computation exit status ... ", if( exitSuccess() ) 'OK' else 'ERROR') if( verbose > 2 ){ if( exitSuccess() ){ message('\n## Running normal exit clean up ... ') }else{ message('\n## Running rollback clean up ... ') } } }, add=TRUE) # RNG restoration on error .RNG_ORIGIN <- getRNG() on.exit({ if( !exitSuccess() ){ if( verbose > 2 ) message("# Restoring RNG settings ... ", appendLF=verbose>3) setRNG(.RNG_ORIGIN) if( verbose > 3 ) showRNG(indent=' #') if( verbose > 2 ) message("OK") } }, add=TRUE) # Set debug/verbosity option just for the time of the run old.opt <- nmf.options(debug=debug, verbose=verbose, shared.memory = shared.memory); on.exit({ if( verbose > 2 ) message("# Restoring NMF options ... ", appendLF=FALSE) nmf.options(old.opt) if( verbose > 2 ) message("OK") }, add=TRUE) # make sure rank is an integer rank <- as.integer(rank) if( length(rank) != 1 ) fstop("invalid argument 'rank': must be a single numeric value") if( rank < 1 ) fstop("invalid argument 'rank': must be greater than 0") # option 'restore.seed' is deprecated if( !is.null(.options$restore.seed) ) fwarning("Option 'restore.seed' is deprecated and discarded since version 0.5.99.") if( verbose ){ if( dry.run ) message("*** fake/dry-run ***") message("NMF algorithm: '", name(method), "'") } ##START_MULTI_RUN # if the number of run is more than 1, then call itself recursively if( nrun > 1 ) { if( verbose ) message("Multiple runs: ", nrun) if( verbose > 3 ){ cat("## OPTIONS:\n") sapply(seq_along(.options) , function(i){ r <- i %% 4 cat(if(r!=1) '\t| ' else "# ", names(.options)[i],': ', .options[[i]], sep='') if(r==0) cat("\n# ") }) if( length(.options) %% 4 != 0 )cat("\n") } ## OPTIONS: parallel computations # option require-parallel: parallel computation is required if TRUE or numeric != 0 opt.parallel.required <- !is.null(.options$parallel.required) && .options$parallel.required # determine specification for parallel computations opt.parallel.spec <- if( opt.parallel.required ){ # priority over try-parallel # option require-parallel implies and takes precedence over option try-parallel .options$parallel.required }else if( !is.null(.options$parallel) ) .options$parallel # priority over .pbackend else !is_NA(.pbackend) # required only if backend is not trivial # determine if one should run in parallel at all: TRUE or numeric != 0, .pbackend not NA opt.parallel <- !is_NA(.pbackend) && (isTRUE(opt.parallel.spec) || opt.parallel.spec) ## if( opt.parallel ){ if( verbose > 1 ) message("# Setting up requested `foreach` environment: " , if( opt.parallel.required ) 'require-parallel' else 'try-parallel' , ' [', quick_str(.pbackend) , ']') # switch doMC backend to doParallel if( isString(.pbackend, 'MC', ignore.case=TRUE) ){ .pbackend <- 'par' } # try setting up parallel foreach backend oldBackend <- setupBackend(opt.parallel.spec, .pbackend, !opt.parallel.required, verbose=verbose) opt.parallel <- !isFALSE(oldBackend) # setup backend restoration if using one different from the current one if( opt.parallel && !is_NA(oldBackend) ){ on.exit({ if( verbose > 2 ){ message("# Restoring previous foreach backend '", getDoBackendName(oldBackend) ,"' ... ", appendLF=FALSE) } setDoBackend(oldBackend, cleanup=TRUE) if( verbose > 2 ) message('OK') }, add=TRUE) }# # From this point, the backend is registered # => one knows if we'll run a sequential or parallel foreach loop .MODE_SEQ <- is.doSEQ() MODE_PAR <- .MODE_PAR <- !.MODE_SEQ } # check seed method: fixed values are not sensible -> warning .checkRandomness <- FALSE if( is.nmf(seed) && !is.empty.nmf(seed) ){ .checkRandomness <- TRUE } # start_RNG_all # if the seed is numerical or a rstream object, then use it to set the # initial state of the random number generator: # build a sequence of RNGstreams: if no suitable seed is provided # then the sequence use a random seed generated with a single draw # of the current active RNG. If the seed is valid, then the # # setup the RNG sequence # override with standard RNG if .options$RNGstream=FALSE resetRNG <- NULL if( !.options$RNGstream && (!opt.parallel || .MODE_SEQ) ){ .RNG.seed <- rep(list(NULL), nrun) if( isNumber(rng) ){ resetRNG <- getRNG() if( verbose > 2 ) message("# Force using current RNG settings seeded with: ", rng) set.seed(rng) }else if( verbose > 2 ) message("# Force using current RNG settings") }else{ .RNG.seed <- setupRNG(rng, n = nrun, verbose=verbose) # restore the RNG state on exit as after RNGseq: # - if no seeding occured then the RNG has still been drawn once in RNGseq # which must be reflected so that different unseeded calls use different RNG states # - one needs to restore the RNG because it switched to L'Ecuyer-CMRG. resetRNG <- getRNG() } stopifnot( length(.RNG.seed) == nrun ) # update RNG settings on exit if necessary # and only if no error occured if( !is.null(resetRNG) ){ on.exit({ if( exitSuccess() ){ if( verbose > 2 ) message("# Updating RNG settings ... ", appendLF=FALSE) setRNG(resetRNG) if( verbose > 2 ) message("OK") if( verbose > 3 ) showRNG() } }, add=TRUE) } #end_RNG_all ####FOREACH_NMF if( opt.parallel ){ if( verbose ){ if( verbose > 1 ) message("# Using foreach backend: ", getDoParName() ," [version ", getDoParVersion(),"]") # show number of processes if( getDoParWorkers() == 1 ) message("Mode: sequential [foreach:",getDoParName(),"]") else message("Mode: parallel ", str_c("(", getDoParWorkers(), '/', parallel::detectCores()," core(s))")) } # check shared memory capability .MODE_SHARED <- !keep.all && setupSharedMemory(verbose) # setup temporary directory when not keeping all fits if( !keep.all || verbose ){ NMF_TMPDIR <- setupTempDirectory(verbose) # delete on exit if( .CLEANUP ){ on.exit({ if( verbose > 2 ) message("# Deleting temporary directory '", NMF_TMPDIR, "' ... ", appendLF=FALSE) unlink(NMF_TMPDIR, recursive=TRUE) if( verbose > 2 ) message('OK') }, add=TRUE) } } run.all <- function(x, rank, method, seed, model, .options, ...){ ## 1. SETUP # load some variables from parent environment to ensure they # are exported in the foreach loop MODE_SEQ <- .MODE_SEQ MODE_SHARED <- .MODE_SHARED verbose <- verbose keep.all <- keep.all opt.gc <- .options$garbage.collect CALLBACK <- .callback .checkRandomness <- .checkRandomness # check if single or multiple host(s) hosts <- unique(getDoParHosts()) if( verbose > 2 ) message("# Running on ", length(hosts), " host(s): ", str_out(hosts)) SINGLE_HOST <- length(hosts) <= 1L MODE_SHARED <- MODE_SHARED && SINGLE_HOST if( verbose > 2 ) message("# Using shared memory ... ", MODE_SHARED) # setup mutex evaluation function mutex_eval <- if( MODE_SHARED ) ts_eval(verbose = verbose > 4) else force # Specific thing only if one wants only the best result if( !keep.all ){ NMF_TMPDIR <- NMF_TMPDIR # - Define the shared memory objects vOBJECTIVE <- gVariable(as.numeric(NA), MODE_SHARED) # the consensus matrix is computed only if not all the results are kept vCONSENSUS <- gVariable(matrix(0, ncol(x), ncol(x)), MODE_SHARED) } ## 2. RUN # ensure that the package NMF is in each worker's search path .packages <- setupLibPaths('NMF', verbose>3) # export all packages that contribute to NMF registries, # e.g., algorithms or seeding methods. # This is important so that these can be found in worker nodes # for non-fork clusters. if( !is.null(contribs <- registryContributors(package = 'NMF')) ){ .packages <- c(.packages, contribs) } # export dev environment if in dev mode # .export <- if( isDevNamespace('NMF') && !is.doSEQ() ) ls(asNamespace('NMF')) # in parallel mode: verbose message from each run are only shown in debug mode .options$verbose <- FALSE if( verbose ){ if( debug || (.MODE_SEQ && verbose > 1) ) .options$verbose <- verbose if( (!.MODE_SEQ && !debug) || (.MODE_SEQ && verbose == 1) ){ if( verbose == 1 ){ # create progress bar pbar <- txtProgressBar(0, nrun+1, width=50, style=3, title='Runs:' , shared=NMF_TMPDIR) }else{ cat("Runs: ") } } } # get options from master process to pass to workers nmf.opts <- nmf.options() # load extra required packages for shared mode if( MODE_SHARED ) .packages <- c(.packages, 'bigmemory', 'synchronicity') res.runs <- foreach(n=1:nrun , RNGobj = .RNG.seed , .verbose = debug , .errorhandling = 'pass' , .packages = .packages # , .export = .export # , .options.RNG=.RNG.seed ) %dopar% { #START_FOREACH_LOOP # Pass options from master process nmf.options(nmf.opts) # in mode sequential or debug: show details for each run if( MODE_SEQ && verbose > 1 ) cat("\n## Run: ",n, "/", nrun, "\n", sep='') # set the RNG if necessary and restore after each run if( MODE_SEQ && verbose > 2 ) message("# Setting up loop RNG ... ", appendLF=FALSE) setRNG(RNGobj, verbose=verbose>3 && MODE_SEQ) if( MODE_SEQ && verbose > 2 ) message("OK") # limited verbosity in simple mode if( verbose && !(MODE_SEQ && verbose > 1)){ if( verbose >= 2 ) mutex_eval( cat('', n) ) else{ # update progress bar (in mutex) mutex_eval(setTxtProgressBar(pbar, n)) # } } # check RNG changes if( n == 1 && .checkRandomness ){ .RNGinit <- getRNG() } # fit a single NMF model res <- nmf(x, rank, method, nrun=1, seed=seed, model=model, .options=.options, ...) if( n==1 && .checkRandomness && rng.equal(.RNGinit) ){ warning("NMF::nmf - You are running multiple non-random NMF runs with a fixed seed") } # if only the best fit must be kept then update the shared objects if( !keep.all ){ # initialise result list resList <- list(filename=NA, residuals=NA, .callback=NULL) ##LOCK_MUTEX mutex_eval({ # check if the run found a better fit .STATIC.err <- vOBJECTIVE() # retrieve approximation error err <- deviance(res) if( is.na(.STATIC.err) || err < .STATIC.err ){ if( n>1 && verbose ){ if( MODE_SEQ && verbose > 1 ) cat("## Better fit found [err=", err, "]\n") else if( verbose >= 2 ) cat('*') } # update residuals vOBJECTIVE(err) # update best fit on disk: use pid if not using shared memory resfile <- hostfile("fit", tmpdir=NMF_TMPDIR, fileext='.rds', pid=!MODE_SHARED) if( MODE_SEQ && verbose > 2 ) message("# Serializing fit object in '", resfile, "' ... ", appendLF=FALSE) saveRDS(res, file=resfile, compress=FALSE) if( MODE_SEQ && verbose > 2 ){ message(if( file.exists(resfile) ) 'OK' else 'ERROR') } # store the filename and achieved objective value in the result list resList$filename <- resfile resList$residuals <- err } ## CONSENSUS # update the consensus matrix if( MODE_SHARED && SINGLE_HOST ){ # on single host: shared memory already contains consensus vCONSENSUS(vCONSENSUS() + connectivity(res, no.attrib=TRUE)) }else{ # on multiple hosts: must return connectivity and aggregate at the end resList$connectivity <- connectivity(res, no.attrib=TRUE) } ## CALLBACK # call the callback function if necessary (return error as well) if( is.function(CALLBACK) ){ resList$.callback <- tryCatch(CALLBACK(res, n), error=function(e) e) } }) ##END_LOCK_MUTEX # discard result object res <- NULL # return description list res <- resList } # garbage collection if requested if( opt.gc && n %% opt.gc == 0 ){ if( verbose > 2 ){ if( MODE_SEQ ) message("# Call garbage collector") else{ mutex_eval( cat('%') ) } } gc(verbose= MODE_SEQ && verbose > 3) } # return the result res } ## END_FOREACH_LOOP if( verbose && !debug ){ if( verbose >= 2 ) cat(" ... DONE\n") else{ setTxtProgressBar(pbar, nrun+1) pbar$kill(.CLEANUP) } } ## 3. CHECK FIT ERRORS errors <- checkErrors(res.runs) if( errors$n > 0 ){ fstop(errors$n,"/", nrun, " fit(s) threw an error.\n" ,"# Error(s) thrown:\n", errors$msg) } ## 4. WRAP UP if( keep.all ){ # result is a list of fits # directly return the list of fits res <- res.runs }else{ # result is a list of lists: filename, .callback # loop over the result files to find the best fit if( verbose > 2 ) message("# Processing partial results ... ", appendLF=FALSE) ffstop <- function(...){ message('ERROR'); fstop(...) } # get best fit index idx <- which.min(sapply(res.runs, '[[', 'residuals')) if( length(idx) == 0L ) ffstop("Unexpected error: no partial result seem to have been saved.") resfile <- res.runs[[idx]]$filename # check existence of the result file if( !file_test('-f', resfile) ) ffstop("could not find temporary result file '", resfile, "'") # update res with a better fit res <- readRDS(resfile) if( !isNMFfit(res) ) ffstop("invalid object found in result file '", resfile, "'") if( verbose > 2 ) message('OK') # wrap the result in a list: fit + consensus res <- list(fit=res, consensus=NA) # CONSENSUS MATRIX if( !is.null(res.runs[[1]]$connectivity) ){ # not MODE_SHARED # aggregate connectivity matrices con <- matrix(0, ncol(x), ncol(x)) sapply(res.runs, function(x){ con <<- con + x$connectivity }) res$consensus <- con }else{ # in MODE_SHARED: get consensus from global shared variable res$consensus <- vCONSENSUS() cn <- colnames(x) if( is.null(cn) ) dimnames(res$consensus) <- NULL else dimnames(res$consensus) <- list(cn, cn) } # CALLBACKS if( !is.null(.callback) ){ res$.callback <- processCallback(res.runs) } } ## if( MODE_SEQ && verbose>1 ) cat("## DONE\n") # return result res } }####END_FOREACH_NMF else{####SAPPLY_NMF run.all <- function(x, rank, method, seed, model, .options, ...){ # by default force no verbosity from the runs .options$verbose <- FALSE if( verbose ){ message("Mode: sequential [sapply]") if( verbose > 1 ){ # pass verbosity options in this case .options$verbose <- verbose } } ## 1. SETUP # define static variables for the case one only wants the best result if( !keep.all ){ # statis list with best result: fit, residual, consensus best.static <- list(fit=NULL, residuals=NA, consensus=matrix(0, ncol(x), ncol(x))) } ## 2. RUN: # perform a single run `nrun` times if( verbose == 2 ){ showRNG() } if( verbose && !debug ) cat('Runs:') res.runs <- mapply(1:nrun, .RNG.seed, FUN=function(n, RNGobj){ #start_verbose if( verbose ){ # in mode verbose > 1: show details for each run if( verbose > 1 ){ cat("\n## Run: ",n, "/", nrun, "\n", sep='') }else{ # otherwise only some details for the first run cat('', n) } }#end_verbose # set the RNG for each run if( verbose > 2 ) message("# Setting up loop RNG ... ", appendLF=FALSE) setRNG(RNGobj, verbose=verbose>3) if( verbose > 2 ) message("OK") # check RNG changes if( n == 1 && .checkRandomness ){ .RNGinit <- getRNG() } # fit a single NMF model res <- nmf(x, rank, method, nrun=1, seed=seed, model=model, .options=.options, ...) if( n==1 && .checkRandomness && rng.equal(.RNGinit) ){ warning("NMF::nmf - You are running multiple non-random NMF runs with a fixed seed" , immediate.=TRUE) } if( !keep.all ){ # initialise result list resList <- list(residuals=NA, .callback=NULL) # check if the run found a better fit err <- residuals(res) best <- best.static$residuals if( is.na(best) || err < best ){ if( verbose ){ if( verbose > 1L ) cat("## Updating best fit [deviance =", err, "]\n", sep='') else cat('*') } # update best fit (only if necessary) best.static$fit <<- res best.static$residuals <<- err resList$residuals <- err } # update the static consensus matrix (only if necessary) best.static$consensus <<- best.static$consensus + connectivity(res, no.attrib=TRUE) # call the callback function if necessary if( !is.null(.callback) ){ resList$.callback <- tryCatch(.callback(res, n), error=function(e) e) } # reset the result to NULL res <- resList } # garbage collection if requested if( opt.gc && n %% opt.gc == 0 ){ if( verbose > 1 ) message("# Call garbage collection NOW") else if( verbose ) cat('%') gc(verbose = verbose > 3) } if( verbose > 1 ) cat("## DONE\n") # return the result res }, SIMPLIFY=FALSE) ## if( verbose && !debug ) cat(" ... DONE\n") ## 3. ERROR CHECK / WRAP UP if( keep.all ){ res <- res.runs }else{ res <- list(fit=best.static$fit, consensus=best.static$consensus) # CALLBACKS if( !is.null(.callback) ){ res$.callback <- processCallback(res.runs) } } res } }####END_SAPPLY_NMF ####END_DEFINE_RUN # perform all the NMF runs t <- system.time({res <- run.all(x=x, rank=rank, method=method, seed=seed, model=model, .options, ...)}) if( verbose && !debug ){ cat("System time:\n") print(t) } if( keep.all ){ # when keeping all the fits: join the results into an NMFfitXn object # TODO: improve memory management here res <- NMFfitX(res, runtime.all=t) return( exitSuccess(res) ) }else{# if one just want the best result only return the best # ASSERT the presence of the result stopifnot( !is.null(res$fit) ) # ASSERT the presence of the consensus matrix stopifnot( !is.null(res$consensus) ) res.final <- NMFfitX(res$fit, consensus=res$consensus/nrun , runtime.all=t, nrun=as.integer(nrun) , rng1=.RNG.seed[[1]]) # ASSERT and add callback if necessary if( !is.null(.callback) ){ stopifnot( !is.null(res$.callback) ) res.final$.callback <- res$.callback } return( exitSuccess(res.final) ) } }##END_MULTI_RUN # start_RNG # show original RNG settings in verbose > 2 if( verbose > 3 ){ message("# ** Current RNG settings:") showRNG() } # do something if the RNG was actually changed newRNG <- getRNG() .RNG.seed <- setupRNG(rng, 1, verbose=verbose-1) # setup restoration if( isRNGseed(rng) ){ if( verbose > 3 ) showRNG() # restore RNG settings on.exit({ if( verbose > 2 ) message("# Restoring RNG settings ... ", appendLF=FALSE) setRNG(newRNG) if( verbose > 2 ) message("OK") if( verbose > 3 ) showRNG() }, add=TRUE) } #end_RNG # CHECK PARAMETERS: # test for negative values in x only if the method is not mixed if( !is.mixed(method) && min(x, na.rm = TRUE) < 0 ) fstop('Input matrix ', substitute(x),' contains some negative entries.'); # test if one row contains only zero entries if( min(rowSums(x, na.rm = TRUE), na.rm = TRUE) == 0 ) fstop('Input matrix ', substitute(x),' contains at least one null or NA-filled row.'); # a priori the parameters for the run are all the one in '...' # => expand with the strategy's defaults (e.g., maxIter) parameters.method <- expand_list(list(...), .method_defaults) # if( is.nmf(seed) ){ if( !is.null(model) ) fwarning("Discarding argument `model`: directly using NMF model supplied in argument `seed`") # if the seed is a NMFfit object then only use the fit (i.e. the NMF model) # => we want a fresh and clean NMFfit object if( isNMFfit(seed) ) seed <- fit(seed) # Wrap up the seed into a NMFfit object seed <- NMFfit(fit=seed, seed='NMF') } else if( !inherits(seed, 'NMFfit') ){ ## MODEL INSTANTIATION : # default NMF model is retrieved from the NMF strategy .modelClass <- modelname(method) # if a character string then use this type of NMF model, but still look # for slots in `...` if( is.character(model) ){ .modelClass <- model model <- NULL } # some of the instantiation parameters are set internally # TODO: change target into x (=> impact on nmfModel ? parameters.model.internal <- list(rank=rank, target=0) parameters.model <- list() init <- if( is.nmf(model) ){ model }else{ # if 'model' is NULL: initialization parameters are searched in '...' if( is.null(model) ){ # extract the parameters from '...' that correspond to slots in the given class stopifnot( isNMFclass(.modelClass) ) parameters <- .extract.slots.parameters(.modelClass, parameters.method) # restrict parameters.method to the ones that won't be used to instantiate the model overriden <- is.element(names(parameters$slots), names(parameters.model.internal)) parameters.method <- c(parameters$extra, parameters$slots[overriden]) #- the model parameters come from the remaining elements parameters.model <- c(model=.modelClass, parameters$slots) } else if( is.list(model) ){ # otherwise argument 'model' must be a list # if the list is not empty then check all elements are named and # not conflicting with the internally set values if( length(model) > 0 ){ # all the elements must be named if( !hasNames(model, all=TRUE) ) fstop("Invalid argument `model` [elements must all be named]. See ?nmf.") # warn the user if some elements are conflicting and won't be used overriden <- is.element(names(model), names(parameters.model.internal)) if( any(overriden) ) warning("NMF::nmf - Model parameter(s) [" , str_out(model[overriden], use.names=TRUE, max=Inf) , "] discarded. Used internally set value(s) [" , str_out(parameters.model.internal[names(model[overriden])], use.names=TRUE, max=Inf) , "]" , call.=FALSE) } # add default model class if necessary if( is.null(model$model) ) model$model <- .modelClass # all the instantiation parameters come from argument 'model' parameters.model <- model }else{ fstop("Invalid argument 'model' [expected NULL, a character string, or a list to set slots in the NMF model class '",.modelClass,"']. See ?nmf.") } #- force the value of the internally set arguments for the instantiation of the model parameters.model <- .merge.override(parameters.model, parameters.model.internal) # at this point 'init' should be the list of the initialization parameters if( !is.list(parameters.model) ){ fstop("Unexpected error: object 'parameters.model' must be a list") } if( !is.element('model', names(parameters.model)) ){ fstop("Unexpected error: object 'parameters.model' must contain an element named 'model'") } parameters.model } ## SEEDING: # the seed must either be an instance of class 'NMF', the name of a seeding method as a character string # or a list of parameters to pass to the 'seed' function. parameters.seed <- list() seed.method <- NULL if( (is.character(seed) && length(seed) == 1) || is.numeric(seed) || is.null(seed) # || is(seed, 'rstream') ) seed.method <- seed else if( is.function(seed) ) seed.method <- seed else if( is.list(seed) ){ # seed is a list... if( !is.null(seed$method) ){ # 'seed' must contain an element giving the method... seed.method <- seed$method parameters.seed <- seed[-which(names(seed)=='method')] } else if ( is.null(names(seed)) || names(seed)[1] == '' ){ # ... or the first element must be a method seed.method <- seed[[1]] if( length(seed) > 1 ) parameters.seed <- seed[2:length(seed)] } else fstop("Invalid parameter: list 'seed' must contain the seeding method through its first element or through an element named 'method' [", str_desc(seed, 2L), "]") # check validity of the method provided via the list if( !is.function(seed.method) && !(is.character(seed.method) && length(seed.method)==1) ) fstop("The seeding method provided by parameter 'seed' [", str_desc(seed.method), "] is invalid: a valid function or a character string is expected") } else fstop("Invalid parameter 'seed'. Acceptable values are:\n\t- ", paste("an object that inherits from class 'NMF'" , "the name of a seeding method (see ?nmfSeed)" , "a valid seed method definition" , "a list containing the seeding method (i.e. a function or a character string) as its first element\n\tor as an element named 'method' [and optionnally extra arguments it will be called with]" , "a numerical value used to set the seed of the random generator" , "NULL to directly pass the model instanciated from arguments 'model' or '...'." , sep="\n\t- ")) # call the 'seed' function passing the necessary parameters if( verbose ) message("NMF seeding method: ", if( is.character(seed.method) || is.numeric(seed.method) ) seed.method else if( is.null(seed.method) ) 'NULL' else if( !is.null(attr(seed.method, 'name')) ) attr(seed.method, 'name') else if( is.function(seed.method) ) '' else NA) #seed <- do.call(getGeneric('seed', package='NMF') seed <- do.call(getGeneric('seed') , c(list(x=x, model=init, method=seed.method), parameters.seed)) # check the validity of the seed if( !inherits(seed, 'NMFfit') ) fstop("The seeding method function should return class 'NMF' [" , if( is.character(seed.method) ) paste('method "', seed.method, "' ", sep='') else NULL , "returned class: '", class(seed), "']") } # -> at this point the 'seed' object is an instance of class 'NMFfit' nmf.debug('nmf', "Seed is of class: '", class(seed), "'") # ASSERT just to be sure if( !inherits(seed, 'NMFfit') ) fstop("Invalid class '", class(seed), "' for the computed seed: object that inherits from class 'NMFfit' expected.") # check the consistency of the NMF model expected by the algorithm and # the one defined by the seed #if( none( sapply(model(method), function(c) extends(model(seed), c)) ) ) if( all( !inherits(fit(seed), modelname(method)) ) ) fstop("Invalid NMF model '", modelname(seed),"': algorithm '", name(method), "' expects model(s) " , paste(paste("'", modelname(method),"'", sep=''), collapse=', ') , " or extension.") # get the complete seeding method's name seed.method <- seeding(seed) ## FINISH SETUP OF THE SEED OBJECT: store some data within the seed so # that strategy methods can access them directly algorithm(seed) <- name(method) # algorithm name seed@distance <- objective(method) # distance name seed@parameters <- parameters.method # extra parameters run.options(seed) <- nmf.options() # set default run options run.options(seed, 'error.track') <- .OPTIONS$track if( is.numeric(.OPTIONS$track) ) run.options(seed, 'track.interval') <- .OPTIONS$track run.options(seed, 'verbose') <- verbose # store ultimate nmf() call seed@call <- match.call() ## ## print options if in verbose > 3 if( verbose > 3 ){ cat("## OPTIONS:\n") sapply(seq_along(.options) , function(i){ r <- i %% 4 cat(if(r!=1) '\t| ' else "# ", names(.options)[i],': ', .options[[i]], sep='') if(r==0) cat("\n") }) if( length(.options) %% 4 != 0 )cat("\n") } ## run parameters: parameters.run <- c(list(object=method, y=x, x=seed), parameters.method) ## Compute the initial residuals if tracking is enabled init.resid <- if( .OPTIONS$track && !is.partial.nmf(seed) ){ do.call('deviance', parameters.run) } ## RUN NMF METHOD: # call the strategy's run method [and time it] t <- system.time({ res <- if( !dry.run ){ do.call('run', parameters.run) }else{ seed } }) ## WRAP/CHECK RESULT res <- .wrapResult(x, res, seed, method=method, seed.method=seed.method, t) if( !isNMFfit(res) ){ # stop if error fstop(res) } ## ## CLEAN-UP + EXTRAS: # add extra information to the object # slot 'parameters' if( length(res@parameters) == 0L && length(parameters.method)>0L ) res@parameters <- parameters.method # last residuals if( length(residuals(res)) == 0 && !is.partial.nmf(seed) ){ parameters.run$x <- res residuals(res, niter=niter(res)) <- do.call('deviance', parameters.run) } # first residual if tracking is enabled if( .OPTIONS$track && !is.null(init.resid) ){ if( !hasTrack(res, niter=0) ) residuals(res, track=TRUE) <- c('0'=init.resid, residuals(res, track=TRUE)) } if( length(residuals(res)) && is.na(residuals(res)) ) warning("NMF residuals: final objective value is NA") res@runtime <- t # return the result exitSuccess(res) }) # wrap result .wrapResult <- function(x, res, seed, method, seed.method, t){ ## wrap into an NMFfit object (update seed) if( !isNMFfit(res) ){ # extract expression data if necessary if( is(res, 'ExpressionSet') ) res <- exprs(res) if( is(x, 'ExpressionSet') ) x <- exprs(x) # wrap if( is.matrix(res) ){ if( ncol(res) == ncol(x) ){# partial fit: coef # force dimnames colnames(res) <- colnames(x) res <- nmfModel(H=res) }else if( nrow(res) == nrow(x) ){# partial fit: basis # force dimnames rownames(res) <- rownames(x) res <- nmfModel(W=res) } }else if( is.list(res) ){ # build NMF model from result list res <- do.call('nmfModel', res) } # substitute model in fit object if( is.nmf(res) ){ tmp <- seed fit(tmp) <- res tmp@runtime <- t res <- tmp } } ## check result if( !isTRUE(err <- .checkResult(res, seed)) ) return(err) ## Enforce some slot values # slot 'method' algorithm(res) <- name(method) # slot 'distance' res@distance <- objective(method) # slot 'seed' if( seed.method != '' ) seeding(res) <- seed.method # set dimnames of the result only if necessary if( is.null(dimnames(res)) ) dimnames(res) <- dimnames(seed) res } # check result .checkResult <- function(fit, seed){ # check the result is of the right type if( !inherits(fit, 'NMFfit') ){ return(str_c("NMF algorithms should return an instance of class 'NMFfit' [returned class:", class(fit), "]")) } # check that the model has been fully estimated if( is.partial.nmf(fit) ){ warning("nmf - The NMF model was only partially estimated [dim = (", str_out(dim(fit), Inf),")].") } # check that the fit conserved all fixed terms (only warning) if( nterms(seed) ){ if( length(i <- icterms(seed)) && !identical(coef(fit)[i,], coef(seed)[i,]) ){ warning("nmf - Fixed coefficient terms were not all conserved in the fit: the method might not support them.") } if( length(i <- ibterms(seed)) && !identical(basis(fit)[,i], basis(seed)[,i]) ){ warning("nmf - Fixed basis terms were not all conserved in the fit: the method might not support them.") } } TRUE } #' Interface for NMF Seeding Methods #' #' @description #' The function \code{seed} provides a single interface for calling all seeding #' methods used to initialise NMF computations. #' These methods at least set the basis and coefficient matrices of the initial #' \code{object} to valid nonnegative matrices. #' They will be used as a starting point by any NMF algorithm that accept #' initialisation. #' #' IMPORTANT: this interface is still considered experimental and is subject #' to changes in future release. #' #' @param x target matrix one wants to approximate with NMF #' @param model specification of the NMF model, e.g., the factorization rank. #' @param method specification of a seeding method. #' See each method for details on the supported formats. #' @param ... extra to allow extensions and passed down to the actual seeding method. #' #' @return an \code{\linkS4class{NMFfit}} object. #' #' @inline #' @export setGeneric('seed', function(x, model, method, ...) standardGeneric('seed') ) #' This is the workhorse method that seeds an NMF model object using a given #' seeding strategy defined by an \code{NMFSeed} object, to fit a given #' target matrix. #' #' @param rng rng setting to use. #' If not missing the RNG settings are set and restored on exit using #' \code{\link{setRNG}}. #' #' All arguments in \code{...} are passed to teh seeding strategy. #' setMethod('seed', signature(x='matrix', model='NMF', method='NMFSeed'), function(x, model, method, rng, ...){ # debug message nmf.debug('seed', "use seeding method: '", name(method), "'") # temporarly set the RNG if provided if( !missing(rng) ){ orng <- setRNG(rng) on.exit(setRNG(orng)) } # save the current RNG numerical seed rng.s <- getRNG() # create the result NMFfit object, storing the RNG numerical seed res <- NMFfit() # ASSERT: check that the RNG seed is correctly set stopifnot( rng.equal(res,rng.s) ) # call the seeding function passing the extra parameters f <- do.call(algorithm(method), c(list(model, x), ...)) # set the dimnames from the target matrix dimnames(f) <- dimnames(x) # set the basis names from the model if any if( !is.null(basisnames(model)) ) basisnames(f) <- basisnames(model) # store the result into the NMFfit object fit(res) <- f # if not already set: store the seeding method's name in the resulting object if( seeding(res) == '' ) seeding(res) <- name(method) # return the seeded object res } ) #' Seeds an NMF model using a custom seeding strategy, defined by a function. #' #' \code{method} must have signature \code{(x='NMFfit', y='matrix', ...)}, where #' \code{x} is the unseeded NMF model and \code{y} is the target matrix to fit. #' It must return an \code{\linkS4class{NMF}} object, that contains the seeded #' NMF model. #' #' @param name optional name of the seeding method for custom seeding strategies. #' setMethod('seed', signature(x='ANY', model='ANY', method='function'), function(x, model, method, name, ...){ # generate runtime name if necessary if( missing(name) ) name <- basename(tempfile("NMF.seed.")) # check that the name is not a registered name if( existsNMFSeed(name) ) stop("Invalid name for custom seeding method: '",name,"' is already a registered seeding method") # wrap function method into a new NMFSeed object seedObj <- new('NMFSeed', name=name, method=method) # call version with NMFSeed seed(x, model, seedObj, ...) } ) #' Seeds the model with the default seeding method given by #' \code{nmf.getOption('default.seed')} setMethod('seed', signature(x='ANY', model='ANY', method='missing'), function(x, model, method, ...){ seed(x, model, nmf.getOption('default.seed'), ...) } ) #' Use NMF method \code{'none'}. setMethod('seed', signature(x='ANY', model='ANY', method='NULL'), function(x, model, method, ...){ seed(x, model, 'none', ...) } ) #' Use \code{method} to set the RNG with \code{\link{setRNG}} and use method #' \dQuote{random} to seed the NMF model. #' #' Note that in this case the RNG settings are not restored. #' This is due to some internal technical reasons, and might change in future #' releases. setMethod('seed', signature(x='ANY', model='ANY', method='numeric'), function(x, model, method, ...){ # set the seed using the numerical value by argument 'method' orng <- setRNG(method) #TODO: restore the RNG state? # call seeding method 'random' res <- seed(x, model, 'random', ...) # return result return(res) } ) #setMethod('seed', signature(x='ANY', model='ANY', method='rstream'), # function(x, model, method, ...){ # # # set the seed using the numerical value by argument 'method' # orng <- setRNG(method) # #TODO: restore the RNG state? # # # call seeding method 'random' # res <- seed(x, model, 'random', ...) # # # return result # return(res) # } #) #' Use the registered seeding method whose access key is \code{method}. setMethod('seed', signature(x='ANY', model='ANY', method='character'), function(x, model, method, ...){ # get the seeding method from the registry seeding.fun <- nmfSeed(method) #Vc#Use seeding method: '${method}' # call 'seed' with the seeding.function seed(x, model, method=seeding.fun, ...) } ) #' Seed a model using the elements in \code{model} to instantiate it with #' \code{\link{nmfModel}}. setMethod('seed', signature(x='ANY', model='list', method='NMFSeed'), function(x, model, method, ...){ ## check validity of the list: there should be at least the NMF (sub)class name and the rank if( length(model) < 2 ) stop("Invalid parameter: list 'model' must contain at least two elements giving the model's class name and the factorization rank") # 'model' must contain an element giving the class to instanciate if( is.null(model$model) ){ err.msg <- "Invalid parameter: list 'model' must contain a valid NMF model classname in an element named 'model' or in its first un-named element" unamed <- if( !is.null(names(model)) ) which(names(model) %in% c('', NA)) else 1 if ( length(unamed) > 0 ){ # if not the first unamed element is taken as the class name idx <- unamed[1] val <- unlist(model[idx], recursive=FALSE) if( is.character(val) && length(val)==1 && extends(val, 'NMF') ) names(model)[idx] <- 'model' else stop(err.msg) }else stop(err.msg) } # 'model' must contain an element giving the factorization rank if( is.null(model$rank) ){ err.msg <- "Invalid parameter: list 'model' must contain the factorization rank in an element named 'rank' or in its second un-named element" unamed <- if( !is.null(names(model)) ) which(names(model) %in% c('', NA)) else 1 if ( length(unamed) > 0 ){ # if not the second element is taken as the factorization rank idx <- unamed[1] val <- unlist(model[idx], recursive=FALSE) if( is.numeric(val) && length(val)==1 ) names(model)[idx] <- 'rank' else stop(err.msg) } else stop(err.msg) } nmf.debug('seed', "using model parameters:\n", capture.output(print(model)) ) # instantiate the object using the factory method model <- do.call('nmfModel', model) nmf.debug('seed', "using NMF model '", class(model), "'") # check that model is from the right type, i.e. inherits from class NMF if( !inherits(model, 'NMF') ) stop("Invalid object returned by model: object must inherit from class 'NMF'") seed(x, model, method, ...) } ) #' Seeds a standard NMF model (i.e. of class \code{\linkS4class{NMFstd}}) of rank #' \code{model}. setMethod('seed', signature(x='ANY', model='numeric', method='NMFSeed'), function(x, model, method, ...){ seed(x, nmfModel(model), method, ...) } ) ###% Extract from a list the elements that can be used to initialize the slot of a class. ###% ###% This function only extract named elements. ###% ###% @param class.name Name of the class from whose slots will be search into '...' ###% @param ... The parameters in which the slot names will be search for ###% ###% @return a list with two elements: ###% - \code{slots}: is a list that contains the named parameters that can be used to instantiate an object of class \code{class.name} ###% - \code{extra}: is a list of the remaining parameters from \code{parameters} (i.e. the ones that do not correspond to a slot). ###% .extract.slots.parameters <- function(class.name, ...){ # check validity of class.name if( !isClass(class.name) ) stop("Invalid class name: class '", class.name, "' dose not exist") # transform '...' into a list parameters <- list(...) if( length(parameters) == 1L && is.null(names(parameters)) ){ parameters <- parameters[[1L]] } # get the slots from the class name slots <- slotNames(class.name) # get the named parameters that correspond to a slot in.slots <- is.element(names(parameters), slots) # return the two lists list( slots=parameters[in.slots], extra=parameters[!in.slots]) } ###% Merges two lists, but overriding with the values of the second list in the case ###% of duplicates. .merge.override <- function(l1, l2, warning=FALSE){ sapply(names(l2), function(name){ if( warning && !is.null(l1[[name]]) ) warning("overriding element '", name, "'") l1[[name]] <<- l2[[name]] }) # return updated list return(l1) } #' Estimate Rank for NMF Models #' #' A critical parameter in NMF algorithms is the factorization rank \eqn{r}. #' It defines the number of basis effects used to approximate the target #' matrix. #' Function \code{nmfEstimateRank} helps in choosing an optimal rank by #' implementing simple approaches proposed in the literature. #' #' Note that from version \emph{0.7}, one can equivalently call the #' function \code{\link{nmf}} with a range of ranks. #' #' @details #' Given a NMF algorithm and the target matrix, a common way of estimating #' \eqn{r} is to try different values, compute some quality measures of the #' results, and choose the best value according to this quality criteria. See #' \cite{Brunet2004} and \cite{Hutchins2008}. #' #' The function \code{nmfEstimateRank} allows to perform this estimation #' procedure. #' It performs multiple NMF runs for a range of rank of #' factorization and, for each, returns a set of quality measures together with #' the associated consensus matrix. #' #' In order to avoid overfitting, it is recommended to run the same procedure on #' randomized data. #' The results on the original and the randomised data may be plotted on the #' same plots, using argument \code{y}. #' #' @param x For \code{nmfEstimateRank} a target object to be estimated, in one #' of the format accepted by interface \code{\link{nmf}}. #' #' For \code{plot.NMF.rank} an object of class \code{NMF.rank} as returned by #' function \code{nmfEstimateRank}. #' @param range a \code{numeric} vector containing the ranks of factorization #' to try. #' Note that duplicates are removed and values are sorted in increasing order. #' The results are notably returned in this order. #' #' @param method A single NMF algorithm, in one of the format accepted by #' the function \code{\link{nmf}}. #' #' @param nrun a \code{numeric} giving the number of run to perform for each #' value in \code{range}. #' #' @param model model specification passed to each \code{nmf} call. #' In particular, when \code{x} is a formula, it is passed to argument #' \code{data} of \code{\link{nmfModel}} to determine the target matrix -- and #' fixed terms. #' #' @param verbose toggle verbosity. This parameter only affects the verbosity #' of the outer loop over the values in \code{range}. #' To print verbose (resp. debug) messages from each NMF run, one can use #' \code{.options='v'} (resp. \code{.options='d'}) #' that will be passed to the function \code{\link{nmf}}. #' #' @param stop logical flag for running the estimation process with fault #' tolerance. When \code{TRUE}, the whole execution will stop if any error is #' raised. When \code{FALSE} (default), the runs that raise an error will be #' skipped, and the execution will carry on. The summary measures for the runs #' with errors are set to NA values, and a warning is thrown. #' #' @param ... For \code{nmfEstimateRank}, these are extra parameters passed #' to interface \code{nmf}. Note that the same parameters are used for each #' value of the rank. See \code{\link{nmf}}. #' #' For \code{plot.NMF.rank}, these are extra graphical parameter passed to the #' standard function \code{plot}. See \code{\link{plot}}. #' #' @return #' \code{nmfEstimateRank} returns a S3 object (i.e. a list) of class #' \code{NMF.rank} with the following elements: #' #' \item{measures }{a \code{data.frame} containing the quality #' measures for each rank of factorizations in \code{range}. Each row #' corresponds to a measure, each column to a rank. } #' \item{consensus }{ a #' \code{list} of consensus matrices, indexed by the rank of factorization (as #' a character string).} #' \item{fit }{ a \code{list} of the fits, indexed by the rank of factorization #' (as a character string).} #' #' @export #' @examples #' #' if( !isCHECK() ){ #' #' set.seed(123456) #' n <- 50; r <- 3; m <- 20 #' V <- syntheticNMF(n, r, m) #' #' # Use a seed that will be set before each first run #' res <- nmfEstimateRank(V, seq(2,5), method='brunet', nrun=10, seed=123456) #' # or equivalently #' res <- nmf(V, seq(2,5), method='brunet', nrun=10, seed=123456) #' #' # plot all the measures #' plot(res) #' # or only one: e.g. the cophenetic correlation coefficient #' plot(res, 'cophenetic') #' #' # run same estimation on randomized data #' rV <- randomize(V) #' rand <- nmfEstimateRank(rV, seq(2,5), method='brunet', nrun=10, seed=123456) #' plot(res, rand) #' } #' nmfEstimateRank <- function(x, range, method=nmf.getOption('default.algorithm') , nrun=30, model=NULL, ..., verbose=FALSE, stop=FALSE){ # fix method if passed NULL (e.g., from nmf('formula', 'numeric')) if( is.null(method) ) method <- nmf.getOption('default.algorithm') # special handling of formula: get target data from the formula if( is(x, 'formula') ){ # dummy model to resolve formula dummy <- nmfModel(x, 0L, data=model) # retrieve target data V <- attr(dummy, 'target') }else{ V <- x } # remove duplicates and sort range <- sort(unique(range)) # initiate the list of consensus matrices: start with single NA values c.matrices <- setNames(lapply(range, function(x) NA), as.character(range)) fit <- setNames(lapply(range, function(x) NA), as.character(range)) bootstrap.measures <- list() # combine function: take all the results at once and merge them into a big matrix comb <- function(...){ measures <- list(...) err <- which( sapply(measures, is.character) ) if( length(err) == length(measures) ){ # all runs produced an error # build an warning using the error messages msg <- paste(paste("#", seq_along(range),' ', measures, sep=''), collapse="\n\t-") stop("All the runs produced an error:\n\t-", msg) }else if( length(err) > 0 ){ # some of the runs returned an error # simplify the results with no errors into a matrix measures.ok <- sapply(measures[-err], function(x) x) # build a NA matrix for all the results n <- nrow(measures.ok) tmp.res <- matrix(as.numeric(NA), n, length(range)) rownames(tmp.res) <- rownames(measures.ok) # set the results that are ok tmp.res[,-err] <- measures.ok # set only the rank for the error results tmp.res['rank', err] <- range[err] # build an warning using the error messages msg <- paste(paste("#", err, measures[err], ' ', sep=''), collapse="\n\t-") warning("NAs were produced due to errors in some of the runs:\n\t-", msg) # return full matrix tmp.res } else # all the runs are ok sapply(measures, function(x) x) } # measures <- foreach(r = range, .combine=comb, .multicombine=TRUE, .errorhandling='stop') %do% { k.rank <- 0 measures <- sapply(range, function(r, ...){ k.rank <<- k.rank + 1L if( verbose ) cat("Compute NMF rank=", r, " ... ") # restore RNG on exit (except after last rank) # => this ensures the methods use the same stochastic environment orng <- RNGseed() if( k.rank < length(range) ) on.exit( RNGseed(orng), add = TRUE) res <- tryCatch({ #START_TRY res <- nmf(x, r, method, nrun=nrun, model=model, ...) # directly return the result if a valid NMF result if( !isNMFfit(res, recursive = FALSE) ) return(res) # store the consensus matrix c.matrices[[as.character(r)]] <<- consensus(res) # store the fit fit[[as.character(r)]] <<- res # if confidence intervals must be computed then do it # if( conf.interval ){ # # resample the tries # samp <- sapply(seq(5*nrun), function(i){ sample(nrun, nrun, replace=TRUE) }) # # bootstrap.measures[[as.character(r)]] <<- apply(samp, 2, function(s){ # res.sample <- join(res[s]) # summary(res.sample, target=x) # }) # } # compute quality measures if( verbose ) cat('+ measures ... ') measures <- summary(res, target=V) if( verbose ) cat("OK\n") # return the measures measures } #END_TRY , error = function(e) { mess <- if( is.null(e$call) ) e$message else paste(e$message, " [in call to '", e$call[1],"']", sep='') mess <- paste('[r=', r, '] -> ', mess, sep='') if( stop ){ # throw the error if( verbose ) cat("\n") stop(mess, call.=FALSE) } # pass the error message if( verbose ) message("ERROR") return(mess) } ) # return the result res } , ..., simplify=FALSE) measures <- do.call(comb, measures) # reformat the result into a data.frame measures <- as.data.frame(t(measures)) # wrap-up result into a 'NMF.rank' S3 object res <- list(measures=measures, consensus=c.matrices, fit=fit) #if( conf.interval ) res$bootstrap.measure <- bootstrap.measures class(res) <- 'NMF.rank' return(res) } #' @S3method summary NMF.rank summary.NMF.rank <- function(object, ...){ s <- summary(new('NMFList', object$fit), ...) # NB: sort measures in the same order as required in ... i <- which(!names(s) %in% names(object$measures)) cbind(s[, i], object$measures[match(object$measures$rank, s$rank), ]) } #' \code{plot.NMF.rank} plots the result of rank estimation survey. #' #' In the plot generated by \code{plot.NMF.rank}, each curve represents a #' summary measure over the range of ranks in the survey. #' The colours correspond to the type of data to which the measure is related: #' coefficient matrix, basis component matrix, best fit, or consensus matrix. #' #' @param y reference object of class \code{NMF.rank}, as returned by #' function \code{nmfEstimateRank}. #' The measures contained in \code{y} are used and plotted as a reference. #' It is typically used to plot results obtained from randomized data. #' The associated curves are drawn in \emph{red} (and \emph{pink}), #' while those from \code{x} are drawn in \emph{blue} (and \emph{green}). #' @param what a \code{character} vector whose elements partially match #' one of the following item, which correspond to the measures computed #' by \code{\link{summary}} on each -- multi-run -- NMF result: #' \sQuote{all}, \sQuote{cophenetic}, \sQuote{rss}, #' \sQuote{residuals}, \sQuote{dispersion}, \sQuote{evar}, #' \sQuote{silhouette} (and more specific *.coef, *.basis, *.consensus), #' \sQuote{sparseness} (and more specific *.coef, *.basis). #' It specifies which measure must be plotted (\code{what='all'} plots #' all the measures). #' @param na.rm single logical that specifies if the rank for which the #' measures are NA values should be removed from the graph or not (default to #' \code{FALSE}). This is useful when plotting results which include NAs due #' to error during the estimation process. See argument \code{stop} for #' \code{nmfEstimateRank}. #' @param xname,yname legend labels for the curves corresponding to measures from #' \code{x} and \code{y} respectively #' @param xlab x-axis label #' @param ylab y-axis label #' @param main main title #' #' @S3method plot NMF.rank #' @rdname nmfEstimateRank #' @import ggplot2 #' @import reshape2 plot.NMF.rank <- function(x, y=NULL, what=c('all', 'cophenetic', 'rss', 'residuals' , 'dispersion', 'evar', 'sparseness' , 'sparseness.basis', 'sparseness.coef' , 'silhouette' , 'silhouette.coef', 'silhouette.basis' , 'silhouette.consensus') , na.rm=FALSE , xname = 'x' , yname = 'y' , xlab = 'Factorization rank' , ylab = '' , main = 'NMF rank survey' , ... ){ # trick for convenience if( is.character(y) && missing(what) ){ what <- y y <- NULL } what <- match.arg(what, several.ok=TRUE) if( 'all' %in% what ){ what <- c('cophenetic', 'rss', 'residuals', 'dispersion', 'evar', 'sparseness', 'silhouette') } .getvals <- function(x, xname){ measures <- x$measures iwhat <- unlist(lapply(paste('^',what,sep=''), grep, colnames(measures))) # remove NA values if required if( na.rm ) measures <- measures[ apply(measures, 1, function(row) !any(is.na(row[iwhat]))), ] vals <- measures[,iwhat, drop=FALSE] x <- as.numeric(measures$rank) xlim <- range(x) # define measure type measure.type <- setNames(rep('Best fit', ncol(measures)), colnames(measures)) cons.measures <- c('silhouette.consensus', 'cophenetic', 'cpu.all') measure.type[match(cons.measures, names(measure.type))] <- 'Consensus' measure.type[grep("\\.coef$", names(measure.type))] <- 'Coefficients' measure.type[grep("\\.basis$", names(measure.type))] <- 'Basis' measure.type <- factor(measure.type) pdata <- melt(cbind(rank = x, vals), id.vars = 'rank') # set measure type pdata$Type <- measure.type[as.character(pdata$variable)] # define measure groups pdata$Measure <- gsub("^([^.]+).*", "\\1", pdata$variable) pdata$Data <- xname pdata } pdata <- .getvals(x, xname) # add reference data if( is(y, 'NMF.rank') ){ pdata.y <- .getvals(y, yname) pdata <- rbind(pdata, pdata.y) } p <- ggplot(pdata, aes_string(x = 'rank', y = 'value')) + geom_line( aes_string(linetype = 'Data', colour = 'Type') ) + geom_point(size = 2, aes_string(shape = 'Data', colour = 'Type') ) + theme_bw() + scale_x_continuous(xlab, breaks = unique(pdata$rank)) + scale_y_continuous(ylab) + ggtitle(main) # remove legend if not necessary if( !is(y, 'NMF.rank') ){ p <- p + scale_shape(guide = 'none') + scale_linetype(guide = 'none') } # use fix set of colors myColors <- brewer.pal(5,"Set1") names(myColors) <- levels(pdata$Type) p <- p + scale_colour_manual(name = "Measure type", values = myColors) # add facet p <- p + facet_wrap( ~ Measure, scales = 'free') # return plot p } NMF/R/registry-algorithms.R0000644000176000001440000003550512234465004015275 0ustar ripleyusers# NMF algorithm registry access methods # # Author: Renaud Gaujoux ############################################################################### #' @include registry.R #' @include NMFStrategy-class.R #' @include NMFStrategyFunction-class.R #' @include NMFStrategyIterative-class.R #' @include NMFStrategyOctave-class.R NULL # create sub-registry for NMF algorithm .registryAlgorithm <- setPackageRegistry('algorithm', "NMFStrategy" , description = "Algorithms to solve MF optimisation problems" , entrydesc = "NMF algorithm") nmfAlgorithmInfo <- function(show=TRUE){ obj <- .registryAlgorithm if( show ) print(obj) invisible(obj) } # specific register method for registering NMFStrategy objects setMethod('nmfRegister', signature(key='NMFStrategy', method='missing'), function(key, method, ...){ nmfRegister(name(key), key, ..., regname='algorithm') } ) #' Registering NMF Algorithms #' #' Adds a new algorithm to the registry of algorithms that perform #' Nonnegative Matrix Factorization. #' #' @inheritParams NMFStrategy #' @param ... arguments passed to the factory function \code{\link{NMFStrategy}}, #' which instantiate the \code{\linkS4class{NMFStrategy}} object that is stored #' in registry. #' @param overwrite logical that indicates if any existing NMF method with the #' same name should be overwritten (\code{TRUE}) or not (\code{FALSE}), #' in which case an error is thrown. #' @param verbose a logical that indicates if information about the registration #' should be printed (\code{TRUE}) or not (\code{FALSE}). #' #' @export #' @examples #' #' # define/regsiter a new -- dummy -- NMF algorithm with the minimum arguments #' # y: target matrix #' # x: initial NMF model (i.e. the seed) #' # NB: this algorithm simply return the seed unchanged #' setNMFMethod('mynmf', function(y, x, ...){ x }) #' #' # check algorithm on toy data #' res <- nmfCheck('mynmf') #' # the NMF seed is not changed #' stopifnot( nmf.equal(res, nmfCheck('mynmf', seed=res)) ) #' setNMFMethod <- function(name, method, ..., overwrite=isLoadingNamespace(), verbose=TRUE){ # build call to NMFStrategy constructor call_const <- match.call(NMFStrategy) call_const[[1]] <- as.name('NMFStrategy') call_const$verbose <- NULL call_const$overwrite <- NULL # swap name and method if method is missing and name is a registered method if( missing(method) && !missing(name) && is.character(name) && existsNMFMethod(name) ){ call_const$method <- name call_const$name <- NULL } # build the NMFStrategy object (in the parent frame to get the package slot right) e <- parent.frame() method <- eval(call_const, envir=e) # add to the algorithm registry res <- nmfRegister(method, overwrite=overwrite, verbose=verbose) # return wrapper function invisibly wrap <- nmfWrapper(method) } #' \code{nmfRegisterAlgorithm} is an alias to \code{setNMFMethod} for backward #' compatibility. #' #' @export #' @rdname setNMFMethod nmfRegisterAlgorithm <- setNMFMethod #' Registry for NMF Algorithms #' #' @name methods-NMF #' @rdname registry-algorithm #' @family regalgo Registry for NMF algorithms NULL #' Testing Compatibility of Algorithm and Models #' #' \code{canFit} is an S4 generic that tests if an algorithm can #' fit a particular model. #' #' @param x an object that describes an algorithm #' @param y an object that describes a model #' @param ... extra arguments to allow extension #' #' @export #' @inline #' @family regalgo setGeneric('canFit', function(x, y, ...) standardGeneric('canFit') ) #' Tells if an NMF algorithm can fit a given class of NMF models #' #' @param exact for logical that indicates if an algorithm is considered able to fit #' only the models that it explicitly declares (\code{TRUE}), or if it should be #' considered able to also fit models that extend models that it explicitly fits. #' setMethod('canFit', signature(x='NMFStrategy', y='character'), function(x, y, exact=FALSE){ if( !exact ){ # check for one model amongst all the models fittable by the strategy can <- if( length(mo <- modelname(x)) > 1 ) sapply(mo, function(m) extends(y, m)) else extends(y, mo) any(can) }else is.element(y, modelname(x)) } ) #' Tells if an NMF algorithm can fit the same class of models as \code{y} setMethod('canFit', signature(x='NMFStrategy', y='NMF'), function(x, y, ...){ canFit(x, modelname(y), ...) } ) #' Tells if a registered NMF algorithm can fit a given NMF model setMethod('canFit', signature(x='character', y='ANY'), function(x, y, ...){ canFit(nmfAlgorithm(x), y, ...) } ) #' \code{selectNMFMethod} tries to select an appropriate NMF algorithm that is #' able to fit a given the NMF model. #' #' @param name name of a registered NMF algorithm #' @param model class name of an NMF model, i.e. a class that inherits from class #' \code{\linkS4class{NMF}}. #' @param load a logical that indicates if the selected algorithms should be loaded #' into \code{NMFStrategy} objects #' @param all a logical that indicates if all algorithms that can fit \code{model} #' should be returned or only the default or first found. #' @param quiet a logical that indicates if the operation should be performed quietly, #' without throwing errors or warnings. #' #' @return \code{selectNMFMethod} returns a character vector or \code{NMFStrategy} objects, #' or NULL if no suitable algorithm was found. #' #' @rdname registry-algorithm #' selectNMFMethod <- function(name, model, load=FALSE, exact=FALSE, all=FALSE, quiet=FALSE){ # lookup for an algorithm suitable for the given NMF model if( !isNMFclass(model) ) stop("argument 'model' must be the name of a class that extends class 'NMF'") algo_list <- if( !missing(name) ){ algo <- nmfAlgorithm(name) name(algo) }else nmfAlgorithm() # lookup for all the algorithms that can fit the given model #NB: if only one model needs to be selected then first look for an exact fit as # this would need to be done with exact=FALSE and TRUE anyways w <- sapply(algo_list, canFit, model, exact= if(all) exact else TRUE) algo <- algo_list[w] # if no suitable algorithm was found, and an exact match is not required # then look for other potential non-exact algorithms if( !all && !exact && length(algo) == 0 ){ w <- sapply(algo_list, canFit, model, exact=FALSE) algo <- algo_list[w] } # return NULL if no algorithm was found if( length(algo) == 0L ){ if( !quiet ) stop("Could not find an NMF algorithm to fit model '", model, "'" , if( !missing(name) ) paste(" amongst ", str_out(algo_list, Inf))) return(NULL) } # if all=FALSE then try to choose the default algorithm if present in the list, or the first one res <- if( !all && length(algo) > 1L ){ idx <- which( algo == nmf.getOption('default.algorithm') ) if( !length(idx) ) idx <- 1L res <- algo[idx] if( !quiet ) warning("Selected NMF algorithm '", res, "' amongst other possible algorithm(s): " , paste(paste("'", algo[-idx], "'", sep=''), collapse=", ")) res }else # otherwise return all the algorithms algo # load the methods if required if( load ){ if( length(res) > 1 ) sapply(res, nmfAlgorithm) else nmfAlgorithm(res) } else res } #' \code{getNMFMethod} retrieves NMF algorithm objects from the registry. #' #' @param ... extra arguments passed to \code{\link[pkgmaker]{pkgreg_fetch}} #' or \code{\link[pkgmaker]{pkgreg_remove}}. #' #' @export #' @rdname registry-algorithm getNMFMethod <- function(...) nmfGet('algorithm', ...) #' Listing and Retrieving NMF Algorithms #' #' \code{nmfAlgorithm} lists access keys or retrieves NMF algorithms that are #' stored in registry. #' It allows to list #' #' @param name Access key. #' If not missing, it must be a single character string that is partially matched #' against the available algorithms in the registry. #' In this case, if \code{all=FALSE} (default), then the algorithm is returned #' as an \code{NMFStrategy} object that can be directly passed to \code{\link{nmf}}. #' An error is thrown if no matching algorithm is found. #' #' If missing or \code{NULL}, then access keys of algorithms -- that #' match the criteria \code{version}, are returned. #' This argument is assumed to be regular expression if \code{all=TRUE} or #' \code{version} is not \code{NULL}. #' @param version version of the algorithm(s) to retrieve. #' Currently only value \code{'R'} is supported, which searched for plain R #' implementations. #' @param all a logical that indicates if all algorithm keys should be returned, #' including the ones from alternative algorithm versions (e.g. plain R #' implementations of algorithms, for which a version based on optimised #' C updates is used by default). #' @param ... extra arguments passed to \code{\link{getNMFMethod}} when \code{name} #' is not \code{NULL} and \code{all=FALSE}. It is not used otherwise. #' #' @return an \code{\linkS4class{NMFStrategy}} object if \code{name} is not #' \code{NULL} and \code{all=FALSE}, or a named character vector that contains #' the access keys of the matching algorithms. #' The names correspond to the access key of the primary algorithm: e.g. #' algorithm \sQuote{lee} has two registered versions, one plain R (\sQuote{.R#lee}) #' and the other uses optimised C updates (\sQuote{lee}), which will all get #' named \sQuote{lee}. #' #' @export #' @family regalgo #' #' @examples #' #' # list all main algorithms #' nmfAlgorithm() #' # list all versions of algorithms #' nmfAlgorithm(all=TRUE) #' # list all plain R versions #' nmfAlgorithm(version='R') #' nmfAlgorithm <- function(name=NULL, version=NULL, all=FALSE, ...){ # if one passes an NMFStrategy just returns it if( is(name, 'NMFStrategy') ) return(name) # force all=TRUE if type is provided if( !is.null(version) ) all <- TRUE # directly return the algorithm object if a key is supplied and all=FALSE if( !is.null(name) && !all ) return( getNMFMethod(name, ...) ) # get all algorithms algo <- getNMFMethod(all=TRUE) # set names to match the primary key algo <- setNames(algo, sub("^\\.(.+#)?", '', algo)) # filter out hidden methods if( !all ) algo <- algo[!grepl("^\\.", algo)] # filter out methods not from the requested algorithm if( !is.null(name) ) algo <- algo[grepl(str_c("^", name), names(algo))] # filter out types if( !is.null(version) ){ type <- match.arg(version, c('R')) algo <- Filter( function(x) grepl(str_c("^\\.", version, '#'), x), algo) } # remove names if no arguments if( is.null(version) ) algo <- setNames(algo, NULL) # return the selected algorithm(s) algo } #' \code{existsNMFMethod} tells if an NMF algorithm is registered under the #' #' @param exact a logical that indicates if the access key should be matched #' exactly (\code{TRUE}) or partially (\code{FALSE}). #' #' @export #' @rdname registry-algorithm existsNMFMethod <- function(name, exact=TRUE){ !is.null( getNMFMethod(name, error=FALSE, exact=exact) ) } #' \code{removeNMFMethod} removes an NMF algorithm from the registry. #' #' @export #' @rdname registry-algorithm removeNMFMethod <- function(name, ...){ pkgreg_remove('algorithm', key=name, ...) } #' Wrapping NMF Algorithms #' #' This function creates a wrapper function for calling the function \code{\link{nmf}} #' with a given NMF algorithm. #' #' @param method Name of the NMF algorithm to be wrapped. #' It should be the name of a registered algorithm as returned by \code{\link{nmfAlgorithm}}, #' or an NMF algorithm object (i.e. an instance of \code{\linkS4class{NMFStrategy}}). #' @param ... extra named arguments that define default values for any arguments #' of \code{\link{nmf}} or the algorithm itself. #' @param .FIXED a logical that indicates if the default arguments defined in \code{...} #' must be considered as fixed, i.e. that they are forced to have the defined values and cannot #' be used in a call to the wrapper function, in which case, a warning about discarding them #' is thrown if they are used. #' Non fixed arguments may have their value changed at call time, in which case it is honoured and #' passed to the \code{nmf} call. #' #' \code{.FIXED} may also be a character vector that specifies which argument amongst \code{...} #' should be considered as fixed. #' @return a function with argument \code{...} and a set of default arguments defined #' in \code{...} in the call to \code{nmfWrapper}. #' #' @seealso \code{\link{nmfAlgorithm}}, \code{\link{nmf}} #' @keywords internal #' @export #' #' @examples #' #' # wrap Lee & Seung algorithm into a function #' lee <- nmfWrapper('lee', seed=12345) #' args(lee) #' #' # test on random data #' x <- rmatrix(100,20) #' res <- nmf(x, 3, 'lee', seed=12345) #' res2 <- lee(x, 3) #' nmf.equal(res, res2) #' res3 <- lee(x, 3, seed=123) #' nmf.equal(res, res3) #' #' \dontshow{ #' stopifnot(nmf.equal(res, res2)) #' stopifnot( !nmf.equal(res, res3)) #' } #' #' # argument 'method' has no effect #' res4 <- lee(x, 3, method='brunet') #' nmf.equal(res, res4) #' #' \dontshow{ #' stopifnot(nmf.equal(res, res4)) #' } #' #' nmfWrapper <- function(method, ..., .FIXED=FALSE){ # store original call .call <- match.call() # check that all arguments are named if( nargs() > 1L && any(names(.call)[-(1:2)]=='') ) stop("Invalid call: all arguments must be named.") # store fixed arguments from default arguments .fixedargs <- 'method' .defaults <- names(.call)[-1L] .defaults <- .defaults[!.defaults %in% 'method'] if( length(.defaults) ){ # e <- parent.frame() # for(n in .defaults){ # .call[[n]] <- eval(.call[[n]], envir=e) # } if( isTRUE(.FIXED) ) .fixedargs <- c(.fixedargs, .defaults) else if( is.character(.FIXED) ){ .FIXED <- .FIXED[.FIXED %in% .defaults] .fixedargs <- c(.fixedargs, .FIXED) } } # store in local environment .method <- method .checkArgs <- function(ca, args){ # check for fixed arguments passed in the call that need # to be discarded nm <- names(ca)[-1L] if( any(fnm <- !is.na(pmatch(nm, .fixedargs))) ){ warning("Discarding fixed arguments from wrapped call to ", .call[1L] , " [", str_out(nm[fnm], Inf), '].', immediate.=TRUE) ca <- ca[!c(FALSE, fnm)] } # # start with complete call .call <- ca # set values of wrapper default arguments if any if( length(.defaults) ){ defaults <- args[.defaults] .call <- expand_list(ca, defaults, .exact=FALSE) } # change into a call to nmf .call[[1L]] <- as.name('nmf') .call[['method']] <- force(.method) as.call(.call) } # define wrapper function fwrap <- function(...){ ca <- match.call() args <- formals() .call <- .checkArgs(ca, args) # eval in parent environment e <- parent.frame() eval(.call, envir=e) } # add default arguments to signature if( length(.defaults) ){ formals(fwrap) <- expand_list(formals(fwrap), as.list(.call[.defaults])) } # add arguments from the NMF algorithm if( length(meth <- nmfFormals(.method)) ){ formals(fwrap) <- expand_list(formals(fwrap), meth) } return( fwrap ) } NMF/R/seed-nndsvd.R0000644000176000001440000000770212234465004013466 0ustar ripleyusers#' @include registry-seed.R NULL ###% Seeding method: Nonnegative Double Singular Value Decomposition ###% ###% @author Renaud Gaujoux ###% @creation 17 Jul 2009 ###% Auxliary functions .pos <- function(x){ as.numeric(x>=0) * x } .neg <- function(x){ - as.numeric(x<0) * x } .norm <- function(x){ sqrt(drop(crossprod(x))) } ###% This function implements the NNDSVD algorithm described in Boutsidis (2008) for ###% initializattion of Nonnegative Matrix Factorization Algorithms. ###% ###% @param A the input nonnegative m x n matrix A ###% @param k the rank of the computed factors W,H ###% @param flag indicates the variant of the NNDSVD Algorithm: ###% - flag=0 --> NNDSVD ###% - flag=1 --> NNDSVDa ###% - flag=2 --> NNDSVDar ###% ###% @note This code is a port from the MATLAB code from C. Boutsidis and E. Gallopoulos kindly provided by the authors for research purposes. ###% Original MATLAB code: http://www.cs.rpi.edu/~boutsc/papers/paper1/nndsvd.m ###% ###% @references C. Boutsidis and E. Gallopoulos, ###% SVD-based initialization: A head start for nonnegative matrix factorization, ###% Pattern Recognition, 2007 ###% doi:10.1016/j.patcog.2007.09.010 ###% .nndsvd.wrapper <- function(object, x, densify=c('none', 'average', 'random')){ # match parameter 'densify' densify <- match.arg(densify) flag <- which(densify == c('none', 'average', 'random')) - 1 res <- .nndsvd.internal(x, nbasis(object), flag) # update 'NMF' object .basis(object) <- res$W; .coef(object) <- res$H # return updated object object } ###% Port to R of the MATLAB code from Boutsidis .nndsvd.internal <- function(A, k, flag=0, LINPACK=FALSE){ #check the input matrix if( any(A<0) ) stop('The input matrix contains negative elements !') #size of input matrix size = dim(A); m <- size[1]; n<- size[2] #the matrices of the factorization W = matrix(0, m, k); H = matrix(0, k, n); #1st SVD --> partial SVD rank-k to the input matrix A. s = svd(A, k, k, LINPACK=LINPACK); U <- s$u; S <- s$d; V <- s$v #------------------------------------------------------- # We also recommend the use of propack for the SVD # 1st SVD --> partial SVD rank-k ( propack ) # OPTIONS.tol = 0.00001; % remove comment to this line # [U,S,X] = LANSVD(A,k,'L',OPTIONS); % remove comment to this line #------------------------------------------------------- #choose the first singular triplet to be nonnegative W[,1] = sqrt(S[1]) * abs(U[,1]); H[1,] = sqrt(S[1]) * abs(t(V[,1])); # second SVD for the other factors (see table 1 in Boutsidis' paper) for( i in seq(2,k) ){ uu = U[,i]; vv = V[,i]; uup = .pos(uu); uun = .neg(uu) ; vvp = .pos(vv); vvn = .neg(vv); n_uup = .norm(uup); n_vvp = .norm(vvp) ; n_uun = .norm(uun) ; n_vvn = .norm(vvn) ; termp = n_uup %*% n_vvp; termn = n_uun %*% n_vvn; if (termp >= termn){ W[,i] = sqrt(S[i] * termp) * uup / n_uup; H[i,] = sqrt(S[i] * termp) * vvp / n_vvp; }else{ W[,i] = sqrt(S[i] * termn) * uun / n_uun; H[i,] = sqrt(S[i] * termn) * vvn / n_vvn; } } #------------------------------------------------------------ #actually these numbers are zeros W[W<0.0000000001] <- 0; H[H<0.0000000001] <- 0; if( flag==1 ){ #NNDSVDa: fill in the zero elements with the average ind1 <- W==0 ; ind2 <- H==0 ; average <- mean(A); W[ind1] <- average; H[ind2] <- average; }else if( flag==2 ){#NNDSVDar: fill in the zero elements with random values in the space :[0:average/100] ind1 <- W==0; ind2 <- H==0; n1 <- sum(ind1); n2 <- sum(ind2); average = mean(A); W[ind1] = (average * runif(n1, min=0, max=1) / 100); H[ind2] = (average * runif(n2, min=0, max=1) / 100); } # return matrices W and H list(W=W, H=H) } ########################################################################### # REGISTRATION ########################################################################### setNMFSeed('nndsvd', .nndsvd.wrapper, overwrite=TRUE) NMF/R/rmatrix.R0000644000176000001440000001051512234465004012736 0ustar ripleyusers# Generation of random matrices # # Defines the generic function `rmatrix` and basic methods for it. # # Author: Renaud Gaujoux ############################################################################### #' Generating Random Matrices #' #' The S4 generic \code{rmatrix} generates a random matrix from a given object. #' Methods are provided to generate matrices with entries drawn from any #' given random distribution function, e.g. \code{\link{runif}} or #' \code{\link{rnorm}}. #' #' @param x object from which to generate a random matrix #' #' @export setGeneric('rmatrix', function(x, ...) standardGeneric('rmatrix')) #' Generates a random matrix of given dimensions, whose entries #' are drawn using the distribution function \code{dist}. #' #' This is the workhorse method that is eventually called by all other methods. #' It returns a matrix with: #' \itemize{ #' \item \code{x} rows and \code{y} columns if \code{y} is not missing and #' not \code{NULL}; #' \item dimension \code{x[1]} x \code{x[2]} if \code{x} has at least two elements; #' \item dimension \code{x} (i.e. a square matrix) otherwise. #' } #' #' The default is to draw its entries from the standard uniform distribution using #' the base function \code{\link{runif}}, but any other function that generates #' random numeric vectors of a given length may be specified in argument \code{dist}. #' All arguments in \code{...} are passed to the function specified in \code{dist}. #' #' The only requirement is that the function in \code{dist} is of the following form: #' #' \samp{ #' function(n, ...){ #' # return vector of length n #' ... #' }} #' #' This is the case of all base random draw function such as \code{\link{rnorm}}, #' \code{\link{rgamma}}, etc\ldots #' #' #' @param y optional specification of number of columns #' @param dist a random distribution function or a numeric seed (see details of method #' \code{rmatrix,numeric}) #' @param byrow a logical passed in the internal call to the function #' \code{\link{matrix}} #' @param dimnames \code{NULL} or a \code{list} passed in the internal call to #' the function \code{\link{matrix}} #' @param ... extra arguments passed to the distribution function \code{dist}. #' #' @inline #' #' @examples #' ## Generate a random matrix of a given size #' rmatrix(5, 3) #' \dontshow{ stopifnot( identical(dim(rmatrix(5, 3)), c(5L,3L)) ) } #' #' ## Generate a random matrix of the same dimension of a template matrix #' a <- matrix(1, 3, 4) #' rmatrix(a) #' \dontshow{ stopifnot( identical(dim(rmatrix(a)), c(3L,4L)) ) } #' #' ## Specificy the distribution to use #' #' # the default is uniform #' a <- rmatrix(1000, 50) #' \dontrun{ hist(a) } #' #' # use normal ditribution #' a <- rmatrix(1000, 50, rnorm) #' \dontrun{ hist(a) } #' #' # extra arguments can be passed to the random variate generation function #' a <- rmatrix(1000, 50, rnorm, mean=2, sd=0.5) #' \dontrun{ hist(a) } #' setMethod('rmatrix', 'numeric', function(x, y=NULL, dist=runif, byrow = FALSE, dimnames = NULL, ...){ x <- as.integer(x) # early exit if x has length 0 if( length(x) == 0L ) stop("NMF::rmatrix - invalid empty vector in argument `x`.") # check/ensure that 'dist' is a function. if( is.null(dist) ) dist <- runif if( isNumber(dist) ){ os <- RNGseed() on.exit( RNGseed(os), add=TRUE) set.seed(dist) dist <- runif } if( !is.function(dist) ) stop("NMF::rmatrix - invalid value for argument 'dist': must be a function [class(dist)='", class(dist), "'].") # if 'y' is not specified: if( is.null(y) ){ if( length(x) == 1L ) y <- x # create a square matrix else{ # assume x contains all dimensions (e.g. returned by dim()) y <- x[2L] x <- x[1L] } }else{ y <- as.integer(y) y <- y[1L] # only use first element } # build the random matrix using the distribution function matrix(dist(x*y, ...), x, y, byrow=byrow, dimnames=dimnames) } ) #' Default method which calls \code{rmatrix,vector} on the dimensions of \code{x} #' that is assumed to be returned by a suitable \code{dim} method: #' it is equivalent to \code{rmatrix(dim(x), y=NULL, ...)}. #' #' @examples #' #' # random matrix of the same dimension as another matrix #' x <- matrix(3,4) #' dim(rmatrix(x)) #' setMethod('rmatrix', 'ANY', function(x, ...){ rmatrix(x=dim(x), y=NULL, ...) } ) NMF/R/algorithmic.R0000644000176000001440000001525712234465004013562 0ustar ripleyusers# Definition of a generic interface for algorithms # # Author: Renaud Gaujoux ############################################################################### #' Generic Interface for Algorithms #' #' @description #' The functions documented here are S4 generics that define an general interface for #' -- optimisation -- algorithms. #' #' This interface builds upon the broad definition of an algorithm as a workhorse function #' to which is associated auxiliary objects such as an underlying model or an objective function #' that measures the adequation of the model with observed data. #' It aims at complementing the interface provided by the \code{\link{stats}} package. #' #' @section Interface fo NMF algorithms: #' This interface is implemented for NMF algorithms by the classes \code{\link{NMFfit}}, #' \code{\link{NMFfitX}} and \code{\link{NMFStrategy}}, and their respective sub-classes. #' The examples given in this documentation page are mainly based on this implementation. #' #' @param object an object computed using some algorithm, or that describes an algorithm #' itself. #' @param value replacement value #' @param ... extra arguments to allow extension #' #' @name algorithmic-NMF #' @rdname algorithmic NULL #' @details #' \code{algorithm} and \code{algorithm<-} get/set an object that describes the #' algorithm used to compute another object, or with which it is associated. #' It may be a simple character string that gives the algorithm's names, or an object that #' includes the algorithm's definition itself (e.g. an \code{\link{NMFStrategy}} object). #' #' @export #' @rdname algorithmic setGeneric('algorithm', function(object, ...) standardGeneric('algorithm') ) #' @export #' @rdname algorithmic setGeneric('algorithm<-', function(object, ..., value) standardGeneric('algorithm<-') ) #' @details #' \code{seeding} get/set the seeding method used to initialise the computation of an object, #' i.e. usually the function that sets the starting point of an algorithm. #' #' @export #' @rdname algorithmic setGeneric('seeding', function(object, ...) standardGeneric('seeding') ) #' @export #' @rdname algorithmic setGeneric('seeding<-', function(object, ..., value) standardGeneric('seeding<-') ) #' @details #' \code{niter} and \code{niter<-} get/set the number of iterations performed #' to compute an object. #' The function \code{niter<-} would usually be called just before returning the result #' of an algorithm, when putting together data about the fit. #' #' @export #' @rdname algorithmic setGeneric('niter', function(object, ...) standardGeneric('niter')) #' @rdname algorithmic #' @export setGeneric('niter<-', function(object, ..., value) standardGeneric('niter<-')) #' @details #' \code{nrun} returns the number of times the algorithm has been run to compute #' an object. #' Usually this will be 1, but may be be more if the algorithm involves multiple #' starting points. #' #' @export #' @rdname algorithmic setGeneric('nrun', function(object, ...) standardGeneric('nrun') ) #' Default method that returns the value of attribute \sQuote{nrun}. #' #' Such an attribute my be attached to objects to keep track of data about #' the parent fit object (e.g. by method \code{\link{consensus}}), which #' can be used by subsequent function calls such as plot functions #' (e.g. see \code{\link{consensusmap}}). #' This method returns \code{NULL} if no suitable data was found. setMethod('nrun', 'ANY', function(object){ attr(object, 'nrun') } ) #' @details #' \code{objective} and \code{objective<-} get/set the objective function associated #' with an object. #' Some methods for \code{objective} may also compute the objective value with respect to #' some target/observed data. #' #' @export #' @rdname algorithmic setGeneric('objective', function(object, ...) standardGeneric('objective')) #' @export #' @rdname algorithmic setGeneric('objective<-', function(object, ..., value) standardGeneric('objective<-')) #' @details #' \code{runtime} returns the CPU time required to compute an object. #' This would generally be an object of class \code{\link[=proc.time]{proc_time}}. #' #' @export #' @rdname algorithmic setGeneric('runtime', function(object, ...) standardGeneric('runtime') ) #' @details #' \code{runtime.all} returns the CPU time required to compute a collection of #' objects, e.g. a sequence of independent fits. #' #' @export #' @rdname algorithmic setGeneric('runtime.all', function(object, ...) standardGeneric('runtime.all') ) #' @details #' \code{seqtime} returns the sequential CPU time -- that would be -- required #' to compute a collection of objects. #' It would differ from \code{runtime.all} if the computations were performed #' in parallel. #' #' @export #' @rdname algorithmic setGeneric('seqtime', function(object, ...) standardGeneric('seqtime') ) #' @details #' \code{modelname} returns a the type of model associated with an object. #' #' @rdname algorithmic #' @export setGeneric('modelname', function(object, ...) standardGeneric('modelname')) #' Default method which returns the class name(s) of \code{object}. #' This should work for objects representing models on their own. #' #' For NMF objects, this is the type of NMF model, that corresponds to the #' name of the S4 sub-class of \code{\linkS4class{NMF}}, inherited by \code{object}. #' #' @examples #' # get the type of an NMF model #' modelname(nmfModel(3)) #' modelname(nmfModel(3, model='NMFns')) #' modelname(nmfModel(3, model='NMFOffset')) #' setMethod('modelname', 'ANY', function(object) { as.character(class(object)) } ) #' @details #' \code{run} calls the workhorse function that actually implements a strategy/algorithm, #' and run it on some data object. #' #' @param y data object, e.g. a target matrix #' @param x a model object used as a starting point by the algorithm, #' e.g. a non-empty NMF model. #' #' @export #' @rdname algorithmic setGeneric('run', function(object, y, x, ...) standardGeneric('run')) #' @details #' \code{logs} returns the log messages output during the computation of an #' object. #' @export #' @rdname algorithmic setGeneric('logs', function(object, ...) standardGeneric('logs')) #' Default method that returns the value of attribute/slot \code{'logs'} or, if this latter #' does not exists, the value of element \code{'logs'} if \code{object} is a \code{list}. #' It returns \code{NULL} if no logging data was found. setMethod('logs', 'ANY', function(object) { res <- attr(object, 'logs') if( !is.null(res) ) res else if( is.list(object) ) object$logs } ) #' @details #' \code{compare} compares objects obtained from running separate algorithms. #' #' @export #' @rdname algorithmic setGeneric('compare', function(object, ...) standardGeneric('compare') ) NMF/R/rnmf.R0000644000176000001440000003254512234465004012221 0ustar ripleyusers# Generation of Random NMF Models # # Author: Renaud Gaujoux # Creation: 03 Jul 2012 ############################################################################### #' @include nmfModel.R NULL .rnmf_fixed <- oneoffVariable('none') #' Generates a random NMF model of the same class and rank as another NMF model. #' #' This is the workhorse method that is eventually called by all other methods. #' It generates an NMF model of the same class and rank as \code{x}, compatible with the #' dimensions specified in \code{target}, that can be a single or 2-length #' numeric vector, to specify a square or rectangular target matrix respectively. #' #' The second dimension can also be passed via argument \code{ncol}, so that #' calling \code{rnmf(x, 20, 10, ...)} is equivalent to \code{rnmf(x, c(20, 10), ...)}, #' but easier to write. #' #' The entries are uniformly drawn between \code{0} and \code{max} #' (optionally specified in \code{...}) that defaults to 1. #' #' By default the dimnames of \code{x} are set on the returned NMF model. #' This behaviour is disabled with argument \code{keep.names=FALSE}. #' See \code{\link{nmfModel}}. #' #' @param ncol single numeric value that specifies the number of columns of the #' coefficient matrix. Only used when \code{target} is a single numeric value. #' @param keep.names a logical that indicates if the dimension names of the #' original NMF object \code{x} should be conserved (\code{TRUE}) or discarded #' (\code{FALSE}). #' @param dist specification of the random distribution to use to draw the entries #' of the basis and coefficient matrices. #' It may be specified as: #' \itemize{ #' #' \item a \code{function} which must be a distribution function such as e.g. #' \code{\link{runif}} that is used to draw the entries of both the basis and #' coefficient matrices. It is passed in the \code{dist} argument of #' \code{\link{rmatrix}}. #' #' \item a \code{list} of arguments that are passed internally to \code{\link{rmatrix}}, #' via \code{do.call('rmatrix', dist)}. #' #' \item a \code{character} string that is partially matched to \sQuote{basis} or #' \sQuote{coef}, that specifies which matrix in should be drawn randomly, the #' other remaining as in \code{x} -- unchanged. #' #' \item a \code{list} with elements \sQuote{basis} and/or \sQuote{coef}, which #' specify the \code{dist} argument separately for the basis and coefficient #' matrix respectively. #' #' These elements may be either a distribution function, or a list of arguments that #' are passed internally to \code{\link{rmatrix}}, via #' \code{do.call('rmatrix', dist$basis)} #' or \code{do.call('rmatrix', dist$coef)}. #' } #' #' @inline #' @examples #' #' ## random NMF of same class and rank as another model #' #' x <- nmfModel(3, 10, 5) #' x #' rnmf(x, 20) # square #' rnmf(x, 20, 13) #' rnmf(x, c(20, 13)) #' #' # using another distribution #' rnmf(x, 20, dist=rnorm) #' #' # other than standard model #' y <- rnmf(3, 50, 10, model='NMFns') #' y #' \dontshow{ stopifnot( identical(dim(y), c(50L,10L,3L)) ) } #' \dontshow{ stopifnot( is(y, 'NMFns') ) } #' setMethod('rnmf', signature(x='NMF', target='numeric'), function(x, target, ncol=NULL, keep.names=TRUE, dist=runif){ # store original dimnames if( keep.names ) dn <- dimnames(x) # valid parameter 'target' if( length(target) != 1 && length(target) != 2 ) stop('NMF::rnmf - invalid target dimensions [length must be 1 or 2. Here length = ', length(target) ,']') if( any(is.na(target)) ) stop('NMF::rnmf - invalid target dimensions [NA values in element(s): ', paste(which(is.na(target)), collapse=' and '), ']') # shortcut for symetric case: provide only one dimension if( length(target) == 1L ){ ncol <- if( !is.null(ncol) ){ if( !is.numeric(ncol) || length(ncol) != 1 || is.na(ncol) ) stop("NMF::rnmf - invalid argument `ncol`: must be a single numeric value") ncol }else target target <- c(target, ncol) } # retrieve dimension of the target matrix n <- target[1]; m <- target[2]; # retrieve the factorization rank r <- nbasis(x) ## draw basis and coef matrices # interpret argument dist if( length(dist) == 0L ) dist <- runif if( is.character(dist) ){ dist <- match.arg(dist, c('basis', 'coef')) dist <- setNames(list(runif), dist) } if( is.function(dist) ){ dist <- list(basis = list(x=n, y=r, dist=dist) , coef = list(x=r, y=m, dist=dist)) }else if( is.list(dist) ){ if( !all(names(dist) %in% c('basis', 'coef')) ){ dist <- list(basis=c(list(x=n, y=r), dist) , coef=c(list(x=r, y=m), dist)) }else{ if( !is.null(dist$basis) ) dist$basis <- c(list(x=n, y=r), dist$basis) if( !is.null(dist$coef) ) dist$coef <- c(list(x=r, y=m), dist$coef) } } fixed <- .rnmf_fixed() #Vc# Initialize random matrix: W # NB: this will keep the values of fixed basis terms if( !is.null(dist$basis) && !('basis' %in% fixed) ){ basis(x) <- do.call('rmatrix', dist$basis); } #Vc# Initialize random matrix: H # NB: this will keep the values of fixed coef terms if( !is.null(dist$coef) && !('coef' %in% fixed) ){ coef(x) <- do.call('rmatrix', dist$coef); } # if one needs to keep the names (possibly or reducing/increasing) if( keep.names && !is.null(dn) ) dimnames(x) <- list(dn[[1]][1:n], dn[[2]][1:m], dn[[3]][1:r]) # return the modified object x } ) #' Generates a random NMF model compatible and consistent with a target matrix. #' #' The entries are uniformly drawn between \code{0} and \code{max(target)}. #' It is more or less a shortcut for: #' \samp{ rnmf(x, dim(target), max=max(target), ...)} #' #' It returns an NMF model of the same class as \code{x}. #' #' @param use.dimnames a logical that indicates whether the dimnames of the #' target matrix should be set on the returned NMF model. #' #' @inline #' #' @examples #' # random NMF compatible with a target matrix #' x <- nmfModel(3, 10, 5) #' y <- rmatrix(20, 13) #' rnmf(x, y) # rank of x #' rnmf(2, y) # rank 2 #' setMethod('rnmf', signature(x='ANY', target='matrix'), function(x, target, ..., dist=list(max=max(max(target, na.rm=TRUE), 1)), use.dimnames=TRUE){ # build a random NMF with the dimensions of the target matrix upper-bounded by the target's maximum entry. res <- rnmf(x, dim(target), ..., dist=dist) # compute the upper-bound of the random entries and enforce it if possible no.na <- abs(target[!is.na(target)]) if( length(no.na) > 0 ){ m <- max(no.na) basis(res) <- pmin(basis(res), m) coef(res) <- pmin(coef(res), m) } # set the dimnames from the target matrix if necessary if( use.dimnames ) dimnames(res) <- dimnames(target) # return result res } ) #' Shortcut for \code{rnmf(x, as.matrix(target))}. setMethod('rnmf', signature(x='ANY', target='data.frame'), function(x, target, ...){ rnmf(x, as.matrix(target), ...) } ) #' Generates a random NMF model of the same dimension as another NMF model. #' #' It is a shortcut for \code{rnmf(x, nrow(x), ncol(x), ...)}, which returns #' a random NMF model of the same class and dimensions as \code{x}. #' #' @examples #' ## random NMF from another model #' #' a <- nmfModel(3, 100, 20) #' b <- rnmf(a) #' \dontshow{ stopifnot( !nmf.equal(a,b) ) } #' setMethod('rnmf', signature(x='NMF', target='missing'), function(x, target, ...){ rnmf(x, c(nrow(x),ncol(x)), ...) } ) #' Generates a random NMF model of a given rank, with known basis and/or #' coefficient matrices. #' #' This methods allow to easily generate partially random NMF model, where one #' or both factors are known. #' Although the later case might seems strange, it makes sense for NMF models that #' have fit extra data, other than the basis and coefficient matrices, that #' are drawn by an \code{rnmf} method defined for their own class, which should #' internally call \code{rnmf,NMF,numeric} and let it draw the basis and #' coefficient matrices. #' (e.g. see \code{\linkS4class{NMFOffset}} and \code{\link{rnmf,NMFOffset,numeric-method}}). #' #' Depending on whether arguments \code{W} and/or \code{H} are missing, #' this method interprets \code{x} differently: #' \itemize{ #' #' \item \code{W} provided, \code{H} missing: \code{x} is taken as the number of #' columns that must be drawn to build a random coefficient matrix #' (i.e. the number of columns in the target matrix). #' #' \item \code{W} is missing, \code{H} is provided: \code{x} is taken as the number of #' rows that must be drawn to build a random basis matrix #' (i.e. the number of rows in the target matrix). #' #' \item both \code{W} and \code{H} are provided: \code{x} is taken as the target #' rank of the model to generate. #' \item Having both \code{W} and \code{H} missing produces an error, as the #' dimension of the model cannot be determined in this case. #' } #' #' The matrices \code{W} and \code{H} are reduced if necessary and possible #' to be consistent with this value of the rank, by the internal call to #' \code{\link{nmfModel}}. #' #' All arguments in \code{...} are passed to the function \code{\link{nmfModel}} #' which is used to build an initial NMF model, that is in turn passed to #' \code{rnmf,NMF,numeric} with \code{dist=list(coef=dist)} or #' \code{dist=list(basis=dist)} when suitable. #' The type of NMF model to generate can therefore be specified in argument #' \code{model} (see \code{\link{nmfModel}} for other possible arguments). #' #' The returned NMF model, has a basis matrix equal to \code{W} (if not missing) #' and a coefficient matrix equal to \code{H} (if not missing), or drawn #' according to the specification provided in argument \code{dist} #' (see method \code{rnmf,NMF,numeric} for details on the supported values for \code{dist}). #' #' @examples #' # random NMF model with known basis matrix #' x <- rnmf(5, W=matrix(1:18, 6)) # 6 x 5 model with rank=3 #' basis(x) # fixed #' coef(x) # random #' #' # random NMF model with known coefficient matrix #' x <- rnmf(5, H=matrix(1:18, 3)) # 5 x 6 model with rank=3 #' basis(x) # random #' coef(x) # fixed #' #' # random model other than standard NMF #' x <- rnmf(5, H=matrix(1:18, 3), model='NMFOffset') #' basis(x) # random #' coef(x) # fixed #' offset(x) # random #' setMethod('rnmf', signature(x='numeric', target='missing'), function(x, target, ..., W, H, dist=runif){ # get fixed matrices to restore on exit: # one must enforce honouring the fixed matrices to prevent the call to # rnmf from a sub-class method to change them. of <- .rnmf_fixed() on.exit( .rnmf_fixed(of) ) if( !missing(W) && missing(H) ){ # fixed basis matrix: x = n samples # one must not change the values H .rnmf_fixed('basis') x <- nmfModel(ncol(W), nrow(W), x, W=W, ...) dist <- list(coef=dist) }else if( missing(W) && !missing(H) ){ # fixed coef matrix: x = n features # one must not change the values H .rnmf_fixed('coef') x <- nmfModel(nrow(H), x, ncol(H), H=H, ...) dist <- list(basis=dist) }else if( !missing(W) && !missing(H) ){ # fixed basis and coef: x = rank # one must not change the values of W and H .rnmf_fixed(c('basis', 'coef')) x <- nmfModel(x, nrow(W), ncol(H), W=W, H=H, ...) }else stop("NMF::rnmf - Missing both arguments `W` and/or `H`: at least one of them must be specified.") rnmf(x, dist=dist) } ) #' Generates a random NMF model with known basis and coefficient matrices. #' #' This method is a shortcut for calling \code{rnmf,numeric,missing} with a #' suitable value for \code{x} (the rank), when both factors are known: #' code{rnmf(min(ncol(W), nrow(H)), ..., W=W, H=H)}. #' #' Arguments \code{W} and \code{H} are required. #' Note that calling this method only makes sense for NMF models that contains #' data to fit other than the basis and coefficient matrices, #' e.g. \code{\linkS4class{NMFOffset}}. #' #' @examples #' #' # random model other than standard NMF #' x <- rnmf(W=matrix(1:18, 6), H=matrix(21:38, 3), model='NMFOffset') #' basis(x) # fixed #' coef(x) # fixed #' offset(x) # random #' setMethod('rnmf', signature(x='missing', target='missing'), function(x, target, ..., W, H){ rnmf(min(ncol(W), nrow(H)), ..., W=W, H=H) } ) #' Generates a random standard NMF model of given dimensions. #' #' This is a shortcut for \code{rnmf(nmfModel(x, target, ncol, ...)), dist=dist)}. #' It generates a standard NMF model compatible with the dimensions passed in #' \code{target}, that can be a single or 2-length numeric vector, to specify #' a square or rectangular target matrix respectively. #' See \code{\link{nmfModel}}. #' #' @inheritParams nmfModel,numeric,numeric-method #' #' @examples #' #' ## random standard NMF of given dimensions #' #' # generate a random NMF model with rank 3 that fits a 100x20 matrix #' rnmf(3, 100, 20) #' \dontshow{ stopifnot( identical(dim(rnmf(3, 100, 20)), c(100L,20L,3L)) ) } #' # generate a random NMF model with rank 3 that fits a 100x100 matrix #' rnmf(3, 100) #' \dontshow{ stopifnot( identical(dim(rnmf(3, 100)), c(100L,100L,3L)) ) } #' setMethod('rnmf', signature(x='numeric', target='numeric'), function(x, target, ncol=NULL, ..., dist=runif){ rnmf(nmfModel(x, target, ncol, ...), dist=dist) } ) #' Generate a random formula-based NMF model, using the method #' \code{\link{nmfModel,formula,ANY-method}}. setMethod('rnmf', signature(x='formula', target='ANY'), function(x, target, ..., dist=runif){ # missing target is NULL if( missing(target) ) target <- NULL rnmf(nmfModel(x, target, ...), dist=dist) } ) NMF/R/nmf-package.R0000644000176000001440000001075212530700302013414 0ustar ripleyusers#' @import graphics #' @import rngtools #' @import digest #' @import stringr #' @import stats #' @import methods NULL #library(digest) #' Defunct Functions and Classes in the NMF Package #' #' @name NMF-defunct #' @rdname NMF-defunct NULL #' Deprecated Functions in the Package NMF #' #' @param object an R object #' @param ... extra arguments #' #' @name NMF-deprecated #' @rdname NMF-deprecated NULL #' Algorithms and framework for Nonnegative Matrix Factorization (NMF). #' #' This package provides a framework to perform Non-negative Matrix Factorization (NMF). #' It implements a set of already published algorithms and seeding methods, and provides a framework #' to test, develop and plug new/custom algorithms. #' Most of the built-in algorithms have been optimized in C++, and the main interface function provides #' an easy way of performing parallel computations on multicore machines. #' #' \code{\link{nmf}} Run a given NMF algorithm #' #' @author Renaud Gaujoux \email{renaud@@cbio.uct.ac.za} #' @name NMF-package #' @aliases NMF #' @docType package #' @useDynLib NMF #' #' @bibliography ~/Documents/articles/library.bib #' @references #' \url{http://cran.r-project.org/} #' #' \url{http://nmf.r-forge.project.org} #' @keywords package #' @seealso \code{\link{nmf}} #' @examples #' # generate a synthetic dataset with known classes #' n <- 50; counts <- c(5, 5, 8); #' V <- syntheticNMF(n, counts) #' #' # perform a 3-rank NMF using the default algorithm #' res <- nmf(V, 3) #' #' basismap(res) #' coefmap(res) #' NA devnmf <- function(){ .LOCAL_PKG_NAME <- 'NMF' requireNamespace('devtools') devtools::load_all(.LOCAL_PKG_NAME) compile_src(.LOCAL_PKG_NAME) } # local config info nmfConfig <- mkoptions() .onLoad <- function(libname, pkgname) { # set default number of cores if( pkgmaker::isCHECK() ){ options(cores=2) }else{ if( nchar(nc <- Sys.getenv('R_PACKAGE_NMF_CORES')) > 0 ){ try({ nmf.options(cores=as.numeric(nc)) }) } } # use grid patch? nmf.options(grid.patch = !isFALSE(Sys.getenv_value('R_PACKAGE_NMF_GRID_PATCH'))) pkgEnv <- pkgmaker::packageEnv() .init.sequence <- function(){ ## 0. INITIALIZE PACKAGE SPECFIC OPTIONS #.init.nmf.options() ## 1. INITIALIZE THE NMF MODELS .init.nmf.models() ## 2. INITIALIZE BIOC LAYER b <- body(.onLoad.nmf.bioc) bioc.loaded <- eval(b, envir=pkgEnv) nmfConfig(bioc=bioc.loaded) # 3. SHARED MEMORY if( .Platform$OS.type != 'windows' ){ msg <- if( !require.quiet('bigmemory', character.only=TRUE) ) 'bigmemory' else if( !require.quiet('synchronicity', character.only=TRUE) ) 'synchronicity' else TRUE nmfConfig(shared.memory=msg) } # } # run intialization sequence suppressing messages or not depending on verbosity options .init.sequence() if( getOption('verbose') ) .init.sequence() else suppressMessages(.init.sequence()) return(invisible()) } .onUnload <- function(libpath) { # unload compiled library dlls <- names(base::getLoadedDLLs()) if ( 'NMF' %in% dlls ) library.dynam.unload("NMF", libpath); } .onAttach <- function(libname, pkgname){ # build startup message msg <- NULL details <- NULL ## 1. CHECK BIOC LAYER bioc.loaded <- nmfConfig('bioc')[[1L]] msg <- paste0(msg, 'BioConductor layer') if( is(bioc.loaded, 'try-error') ) msg <- paste0(msg, ' [ERROR]') else if ( isTRUE(bioc.loaded) ) msg <- paste0(msg, ' [OK]') else{ msg <- paste0(msg, ' [NO: missing Biobase]') details <- c(details, " To enable the Bioconductor layer, try: install.extras('", pkgname, "') [with Bioconductor repository enabled]") } # 2. SHARED MEMORY msg <- paste0(msg, ' | Shared memory capabilities') if( .Platform$OS.type != 'windows' ){ conf <- nmfConfig('shared.memory')[[1L]] if( isTRUE(conf) ) msg <- paste0(msg, ' [OK]') else{ msg <- paste0(msg, ' [NO: ', conf, ']') details <- c(details, " To enable shared memory capabilities, try: install.extras('", pkgname, "')") } }else msg <- paste0(msg, ' [NO: windows]') # # 3. NUMBER OF CORES msg <- paste0(msg, ' | Cores ', getMaxCores(), '/', getMaxCores(limit=FALSE)) # # FINAL. CRAN FLAG if( pkgmaker::isCHECK() ){ msg <- paste0(msg, ' | CRAN check') } # # print startup message ver <- if( isDevNamespace() ){ paste0(' [', utils::packageVersion(pkgname), '-devel', ']') }#else{ # utils::packageVersion(pkgname, lib.loc = libname) # } packageStartupMessage(pkgname, ver, ' - ', msg) if( !is.null(details) ){ packageStartupMessage(paste(details, collapse="\n")) } } NMF/R/grid.R0000644000176000001440000000436112234465004012177 0ustar ripleyusers# Grid related functions # # Mainly functions that duplicate grid functions but do not create a new plot # if none is present. # # Author: Renaud Gaujoux # Creation: 04 Jun 2012 ############################################################################### #' @include options.R #' @import grid NULL #' Internal Grid Extension #' #' These functions enable mixing base and grid graphics in \code{\link{aheatmap}}, #' by avoiding calls to the grid internal function \code{'L_gridDirty'}. #' They are not exported (i.e. not tampering core functions) and are only meant for internal #' use within the \pkg{NMF} package. #' #' \code{tryViewport} tries to go down to a viewport in the current tree, #' given its name. #' #' @details #' \code{tryViewport} uses \code{\link[grid]{grid.ls}} and not #' \code{\link{seekViewport}} as the latter would reset the graphic device #' and break the mix grid/base graphic capability. #' #' @param name viewport name #' @param verbose toggle verbosity #' #' @rdname grid #' @keywords internal tryViewport <- function(name, verbose=FALSE){ if( verbose ) message("vp - lookup for ", name) l <- grid.ls(viewports=TRUE, grobs=FALSE, print=FALSE) if( name %in% l$name ){ downViewport(name) } } #' \code{current.vpPath_patched} aims at substituting \code{\link[grid]{current.vpPath}}, #' so that the graphic engine is not reset. #' This is essentially to prevent outputting a blank page at the beginning of PDF #' graphic engines. #' #' @rdname grid current.vpPath_patched <- local({ .current.vpPath <- NULL function(){ f_current.vpPath <- .current.vpPath if( !.use.grid.patch() ) f_current.vpPath <- grid::current.vpPath else if( is.null(f_current.vpPath) ){ # load patch from installed file patch <- source(packagePath('scripts', 'grid.R', package = 'NMF'), local = TRUE) .current.vpPath <<- patch$value f_current.vpPath <- .current.vpPath } # call f_current.vpPath() } }) # Add new option to enable/disable grid patch .OPTIONS$newOptions(grid.patch = FALSE) #' \code{.use.grid.patch} tells if the user enabled patching grid. #' @rdname grid .use.grid.patch <- function(){ !isCHECK() && nmf.getOption('grid.patch') } NMF/R/fixed-terms.R0000644000176000001440000002621312234465004013501 0ustar ripleyusers# Interface for NMF models that contain fixed terms # # Author: Renaud Gaujoux # Creation: 03 Jul 2012 ############################################################################### #' @include NMF-class.R #' @include NMFstd-class.R NULL #' Concatenating NMF Models #' #' Binds compatible matrices and NMF models together. #' #' @param x an NMF model #' @param ... other objects to concatenate. Currently only two objects at a time #' can be concatenated (i.e. \code{x} and \code{..1}). #' @param margin integer that indicates the margin along which to concatenate #' (only used when \code{..1} is a matrix): #' \describe{ #' \item{1L}{} #' \item{2L}{} #' \item{3L}{} #' \item{4L}{} #' } #' If missing the margin is heuristically determined by looking at common #' dimensions between the objects. #' #' @keywords internal setMethod('c', 'NMF', function(x, ..., margin=3L, recursive=FALSE){ y <- ..1 if( is.matrix(y) ){ if( missing(margin) ){ if( nrow(y) == nrow(x) ){ if( ncol(y) == ncol(x) ){ warning("NMF::`c` - Right argument match both target dimensions: concatenating basis columns." , " Use `margin=4L` to concatenate coefficient rows.") } margin <- 3L }else if( ncol(y) == ncol(x) ){ margin <- 4L }else{ stop("NMF::`c` - Incompatible argument dimensions: could not infer concatenation margin.") } } if( margin == 1L ){ # extend basis vectors if( nbterms(x) ){ # cannot extend models with fixed basis terms stop("NMF::`c` - Could not extend basis vectors:" , " NMF model has fixed basis terms [", nbterms(x), "]") } if( ncol(y) != nbasis(x) ){ stop("NMF::`c` - Could not extend basis vectors:" , " incompatible number of columns [", nbasis(x), '!=', ncol(y), "].") } # extend basis vectors basis(x) <- rbind(basis(x), y) } else if( margin == 2L ){ # extend basis profiles if( ncterms(x) ){ # cannot extend models with fixed coef terms stop("NMF::`c` - Could not extend basis profiles:" , " NMF model has fixed coefficient terms [", ncterms(x), "]") } if( nrow(y) != nbasis(x) ){ stop("NMF::`c` - Could not extend basis profiles:" , " incompatible number of rows [", nbasis(x), '!=', nrow(y), "].") } # extend basis profiles coef(x) <- cbind(coef(x), y) } else if( margin == 3L ){ # add basis vectors if( nrow(y) != nrow(x) ){ stop("NMF::`c` - Could not concatenate basis vectors:" , " incompatible number of rows [", nrow(x), '!=', nrow(y), "].") } # bind basis terms .basis(x) <- cbind(basis(x), y) dn <- colnames(.basis(x)) # bind dummy coef .coef(x) <- rbind(coef(x), matrix(NA, ncol(y), ncol(x))) basisnames(x) <- dn } else if( margin == 4L ){ # add basis profiles if( ncol(y) != ncol(x) ){ stop("NMF::`c` - Could not concatenate basis profiles:" , " incompatible number of columns [", ncol(x), '!=', ncol(y), "].") } # bind coef terms .coef(x) <- rbind(coef(x), y) dn <- rownames(.coef(x)) # bind dummy basis .basis(x) <- cbind(basis(x), matrix(NA, nrow(x), nrow(y))) basisnames(x) <- dn }else{ stop("NMF::`c` - Invalid concatenation margin: should be either" , " 1L (basis rows), 2L (coef columns), 3L (basis vectors/columns) or 4L (basis profiles/coef rows).") } }else if( is.nmf(y) ){ # check dimensions if( nrow(x) != nrow(y) ) stop("NMF::`c` - Could not concatenate NMF objects:" , " incompatible number of rows [", nrow(x), '!=', nrow(y), "]") if( ncol(x) != ncol(y) ) stop("NMF::`c` - Could not concatenate NMF objects:" , " incompatible number of columns [", ncol(x), '!=', ncol(y), "]") .basis(x) <- cbind(basis(x), basis(y)) .coef(x) <- rbind(coef(x), coef(y)) }else{ stop("NMF::`c` - Concatenation of an NMF object with objects of class '", class(y), "' is not supported.") } # return augmented object x } ) fterms <- function(value){ res <- list(n=0L, terms=NULL, df=NULL, i=integer()) if( !length(value) ) return(res) # convert into a data.frame if( is.factor(value) ) value <- data.frame(Group=value) else if( is.numeric(value) ) value <- data.frame(Var=value) else if( !is.data.frame(value) ) value <- as.data.frame(value) res$n <- length(value) res$df <- value # generate fixed term matrix terms <- model.matrix(~ -1 + ., data=value) res$terms <- terms # build indexes res$i <- 1:ncol(terms) res } ## #' Annotations in NMF Models ## #' ## #' NMF models may contain annotations for columns/rows and/or rows/features, in ## #' a similar way gene expression data are annotated ## #' \code{\linkS4class{ExpressionSet}} objects in Bioconductor. ## #' ## NULL #' Fixed Terms in NMF Models #' #' These functions are for internal use and should not be called by the end-user. #' #' They use \code{\link{model.matrix}(~ -1 + ., data=value)} to generate suitable #' term matrices. #' #' @param object NMF object to be updated. #' @param value specification of the replacement value for fixed-terms. #' #' @rdname terms-internal #' @keywords internal #' @inline setGeneric('bterms<-', function(object, value) standardGeneric('bterms<-')) #' Default method tries to coerce \code{value} into a \code{data.frame} with #' \code{\link{as.data.frame}}. setReplaceMethod('bterms', signature('NMFstd', 'ANY'), function(object, value){ if( nterms(object) ){ stop("Cannot set fixed basis terms on an object that already has fixed terms:", " these can be set only once and before setting any fixed coefficient term", " [coef=", ncterms(object), ", basis=", nbterms(object), "].") } # build terms t <- fterms(value) if( !t$n ) return(object) # check dimension if( nrow(t$terms) != nrow(object) ){ stop("Invalid fixed basis terms: all terms should have length the number of target rows" , "[terms=", nrow(t$terms), " != ", nrow(object), "=target]") } # set data object@bterms <- t$df # set indexes i <- t$i nv <- nbasis(object) object@ibterms <- nv + i # set terms object <- c(object, t$terms, margin=3L) object } ) #' \code{cterms<-} sets fixed coefficient terms or indexes and should only be #' called on a newly created NMF object, i.e. in the constructor/factory generic #' \code{\link{nmfModel}}. #' #' @rdname terms-internal #' @inline setGeneric('cterms<-', function(object, value) standardGeneric('cterms<-')) #' Default method tries to coerce \code{value} into a \code{data.frame} with #' \code{\link{as.data.frame}}. setReplaceMethod('cterms', signature('NMFstd', 'ANY'), function(object, value){ if( ncterms(object) ){ stop("Cannot set fixed coef terms on an object that already has fixed coef terms:", " these can be set only once", " [coef=", ncterms(object), ", basis=", nbterms(object), "].") } # build terms t <- fterms(value) if( !t$n ) return(object) # check dimension if( nrow(t$terms) != ncol(object) ){ stop("Invalid fixed coefficient terms: all terms should have length the number of target columns" , "[terms=", nrow(t$terms), " != ", ncol(object), "=target]") } # transpose term matrix t$terms <- t(t$terms) # set data object@cterms <- t$df # set indexes i <- t$i nv <- nbasis(object) object@icterms <- nv + i # set terms object <- c(object, t$terms, margin=4L) object } ) #' Fixed Terms in NMF Models #' #' @description #' Formula-based NMF models may contain fixed basis and/or coefficient terms. #' The functions documented here provide access to these data, which are #' read-only and defined when the model object is instantiated #' (e.g., see \code{\link[=nmfModel,formula,ANY-method]{nmfModel,formula-method}}). #' #' \code{ibterms}, \code{icterms} and \code{iterms} respectively return the #' indexes of the fixed basis terms, the fixed coefficient terms and all fixed #' terms, within the basis and/or coefficient matrix of an NMF model. #' #' @param object NMF object #' @param ... extra parameters to allow extension (currently not used) #' #' @export #' @rdname terms setGeneric('ibterms', function(object, ...) standardGeneric('ibterms') ) #' Default pure virtual method that ensure a method is defined for concrete #' NMF model classes. setMethod('ibterms', 'NMF', function(object, ...){ stop("NMF::ibterms is a pure virtual method of interface 'NMF'." ," It should be overloaded in class '", class(object),"'.") } ) #' Method for standard NMF models, which returns the integer vector that is #' stored in slot \code{ibterms} when a formula-based NMF model is instantiated. setMethod('ibterms', 'NMFstd', function(object){ object@ibterms } ) #' @export #' @rdname terms setGeneric('icterms', function(object, ...) standardGeneric('icterms') ) #' Default pure virtual method that ensure a method is defined for concrete #' NMF model classes. setMethod('icterms', 'NMF', function(object, ...){ stop("NMF::icterms is a pure virtual method of interface 'NMF'." ," It should be overloaded in class '", class(object),"'.") } ) #' Method for standard NMF models, which returns the integer vector that is #' stored in slot \code{icterms} when a formula-based NMF model is instantiated. setMethod('icterms', 'NMFstd', function(object){ object@icterms } ) #' @export #' @rdname terms iterms <- function(object, ...){ c(ibterms(object), icterms(object)) } #' \code{nterms}, \code{nbterms}, and \code{ncterms} return, respectively, #' the number of all fixed terms, fixed basis terms and fixed coefficient terms #' in an NMF model. #' In particular: i.e. \code{nterms(object) = nbterms(object) + ncterms(object)}. #' @export #' @rdname terms nterms <- function(object){ length(ibterms(object)) + length(icterms(object)) } #' @export #' @rdname terms nbterms <- function(object){ length(ibterms(object)) } #' @export #' @rdname terms ncterms <- function(object){ length(icterms(object)) } #' \code{bterms} and \code{cterms} return, respectively, the primary data for #' fixed basis and coefficient terms in an NMF model -- as stored in slots #' \code{bterms} and \code{cterms} . #' These are factors or numeric vectors which define fixed basis components, #' e.g., used for defining separate offsets for different \emph{a priori} groups #' of samples, or to incorporate/correct for some known covariate. #' #' @export #' @rdname terms bterms <- function(object){ object@bterms } #' @export #' @rdname terms cterms <- function(object){ object@cterms } #' \code{ibasis} and \code{icoef} return, respectively, the #' indexes of all latent basis vectors and estimated coefficients within the #' basis or coefficient matrix of an NMF model. #' @export #' @rdname terms ibasis <- function(object, ...){ i <- 1:nbasis(object) if( length(idx <- ibterms(object, ...)) ) i[-idx] else i } #' @export #' @rdname terms icoef <- function(object, ...){ i <- 1:nbasis(object) if( length(idx <- icterms(object, ...)) ) i[-idx] else i } #' @S3method t NMFstd t.NMFstd <- function(x){ # transpose and swap factors x <- t.NMF(x) # swap fixed terms bt <- bterms(x) ibt <- ibterms(x) x@bterms <- cterms(x) x@ibterms <- icterms(x) x@cterms <- bt x@icterms <- ibt # returns x } NMF/R/transforms.R0000644000176000001440000001712112234465004013446 0ustar ripleyusers# Transformation methods for matrix-like and NMF objects # # Author: Renaud Gaujoux # Creation: 19 Jan 2012 ############################################################################### #' @include NMF-class.R NULL #' Transforming from Mixed-sign to Nonnegative Data #' #' \code{nneg} is a generic function to transform a data objects that #' contains negative values into a similar object that only contains #' values that are nonnegative or greater than a given threshold. #' #' @param object The data object to transform #' @param ... extra arguments to allow extension or passed down to \code{nneg,matrix} #' or \code{rposneg,matrix} in subsequent calls. #' #' @return an object of the same class as argument \code{object}. #' @export #' @inline #' @family transforms #' setGeneric('nneg', function(object, ...) standardGeneric('nneg')) #' Transforms a mixed-sign matrix into a nonnegative matrix, optionally apply a #' lower threshold. #' This is the workhorse method, that is eventually called by all other #' methods defined in the \code{\link{NMF}} package. #' #' @param method Name of the transformation method to use, that is partially #' matched against the following possible methods: #' \describe{ #' \item{pmax}{Each entry is constrained to be above threshold \code{threshold}.} #' #' \item{posneg}{The matrix is split into its "positive" and "negative" parts, #' with the entries of each part constrained to be above threshold \code{threshold}. #' The result consists in these two parts stacked in rows (i.e. \code{\link{rbind}}-ed) #' into a single matrix, which has double the number of rows of the input #' matrix \code{object}.} #' #' \item{absolute}{The absolute value of each entry is constrained to be above #' threshold \code{threshold}.} #' #' \item{min}{Global shift by adding the minimum entry to each entry, only if #' it is negative, and then apply threshold. #' } #' #' } #' #' @param threshold Nonnegative lower threshold value (single numeric). #' See argument \code{shit} for details on how the threshold is used and affects #' the result. #' @param shift a logical indicating whether the entries below the threshold #' value \code{threshold} should be forced (shifted) to 0 (default) or to #' the threshold value itself. #' In other words, if \code{shift=TRUE} (default) all entries in #' the result matrix are either 0 or strictly greater than \code{threshold}. #' They are all greater or equal than \code{threshold} otherwise. #' #' @seealso \code{\link{pmax}} #' @examples #' #' # random mixed sign data (normal distribution) #' set.seed(1) #' x <- rmatrix(5,5, rnorm, mean=0, sd=5) #' x #' #' # pmax (default) #' nneg(x) #' # using a threshold #' nneg(x, threshold=2) #' # without shifting the entries lower than threshold #' nneg(x, threshold=2, shift=FALSE) #' #' # posneg: split positive and negative part #' nneg(x, method='posneg') #' nneg(x, method='pos', threshold=2) #' #' # absolute #' nneg(x, method='absolute') #' nneg(x, method='abs', threshold=2) #' #' # min #' nneg(x, method='min') #' nneg(x, method='min', threshold=2) #' setMethod('nneg', 'matrix' , function(object, method=c('pmax', 'posneg', 'absolute', 'min'), threshold=0, shift=TRUE){ # match argument method <- match.arg(method) if( !is.numeric(threshold) || length(threshold) != 1L ) stop("nneg - Invalid threshold value in argument `threshold` [",threshold,"]: must be a single numeric value.") if( threshold < 0 ) stop("nneg - Invalid threshold value in argument `threshold` [",threshold,"]: must be nonnegative.") # 1. Transform if there is any negative entry m <- min(object) if( m < 0 ){ object <- switch(method , pmax = pmax(object, 0) , posneg = rbind(pmax(object, 0), pmax(-object, 0)) , absolute = pmax(abs(object), 0) , min = object - m , stop("NMF::nneg - Unexpected error: unimplemented transformation method '", method, "'.") ) } if( threshold > 0 ){ # 2. Apply threshold if any object <- pmax(object, threshold) # 3. Shifting: entries under threshold if( shift ) object[object<=threshold] <- 0 } # return modified object object } ) #' Apply \code{nneg} to the basis matrix of an \code{\link{NMF}} #' object (i.e. \code{basis(object)}). #' All extra arguments in \code{...} are passed to the method \code{nneg,matrix}. #' #' @examples #' #' # random #' M <- nmfModel(x, rmatrix(ncol(x), 3)) #' nnM <- nneg(M) #' basis(nnM) #' # mixture coefficients are not affected #' identical( coef(M), coef(nnM) ) #' setMethod('nneg', 'NMF', function(object, ...){ basis(object) <- nneg(basis(object), ...) object } ) #' \code{posneg} is a shortcut for \code{nneg(..., method='posneg')}, to split #' mixed-sign data into its positive and negative part. #' See description for method \code{"posneg"}, in \code{\link{nneg}}. #' #' @export #' @rdname nneg #' @examples #' # shortcut for the "posneg" transformation #' posneg(x) #' posneg(x, 2) #' posneg <- function(...) nneg(..., method='posneg') #' Transforming from Nonnegative to Mixed Sign Data #' #' \code{rposneg} performs the "reverse" transformation of the \code{\link{posneg}} function. #' #' @return an object of the same type of \code{object} #' @rdname nneg #' @inline #' setGeneric('rposneg', function(object, ...) standardGeneric('rposneg')) #' @param unstack Logical indicating whether the positive and negative parts #' should be unstacked and combined into a matrix as \code{pos - neg}, which contains #' half the number of rows of \code{object} (default), or left #' stacked as \code{[pos; -neg]}. #' #' @export #' @examples #' #' # random mixed sign data (normal distribution) #' set.seed(1) #' x <- rmatrix(5,5, rnorm, mean=0, sd=5) #' x #' #' # posneg-transform: split positive and negative part #' y <- posneg(x) #' dim(y) #' # posneg-reverse #' z <- rposneg(y) #' identical(x, z) #' rposneg(y, unstack=FALSE) #' #' # But posneg-transformation with a non zero threshold is not reversible #' y1 <- posneg(x, 1) #' identical(rposneg(y1), x) #' setMethod('rposneg', 'matrix' , function(object, unstack=TRUE){ # check that the number of rows is pair if( nrow(object) %% 2 != 0 ) stop("rposneg - Invalid input matrix: must have a pair number of rows [",nrow(object),"].") n2 <- nrow(object) n <- n2/2 if( unstack ) object <- object[1:n,,drop=FALSE] - object[(n+1):n2,,drop=FALSE] else object[(n+1):n2,] <- - object[(n+1):n2,,drop=FALSE] # return modified object object } ) #' Apply \code{rposneg} to the basis matrix of an \code{\link{NMF}} object. #' #' @examples #' #' # random mixed signed NMF model #' M <- nmfModel(rmatrix(10, 3, rnorm), rmatrix(3, 4)) #' # split positive and negative part #' nnM <- posneg(M) #' M2 <- rposneg(nnM) #' identical(M, M2) setMethod('rposneg', 'NMF' , function(object, ...){ basis(object) <- rposneg(basis(object), ...) object } ) #' Transformation NMF Model Objects #' #' \code{t} transpose an NMF model, by transposing and swapping its basis and #' coefficient matrices: \eqn{t([W,H]) = [t(H), t(W)]}. #' #' The function \code{t} is a generic defined in the \pkg{base} package. #' The method \code{t.NMF} defines the trasnformation for the general NMF interface. #' This method may need to be overloaded for NMF models, whose structure requires #' specific handling. #' #' @param x NMF model object. #' #' @family transforms #' @S3method t NMF #' @examples #' #' x <- rnmf(3, 100, 20) #' x #' # transpose #' y <- t(x) #' y #' #' # factors are swapped-transposed #' stopifnot( identical(basis(y), t(coef(x))) ) #' stopifnot( identical(coef(y), t(basis(x))) ) #' t.NMF <- function(x){ # transpose and swap factors w <- t(basis(x)) .basis(x) <- t(coef(x)) .coef(x) <- w # return object x } NMF/R/NMFfit-class.R0000644000176000001440000006301512234470405013502 0ustar ripleyusers# Implementation of class NMFfit # # This class manages the result of a single run of a NMF algorithm. # # Author: Renaud Gaujoux ############################################################################### #' @include fixed-terms.R #' @include nmfModel.R NULL #' Base Class for to store Nonnegative Matrix Factorisation results #' #' Base class to handle the results of general \strong{Nonnegative Matrix #' Factorisation} algorithms (NMF). #' #' It provides a general structure and generic functions to manage the results #' of NMF algorithms. It contains a slot with the fitted NMF model (see slot #' \code{fit}) as well as data about the methods and parameters used to compute #' the factorization. #' #' The purpose of this class is to handle in a generic way the results of NMF #' algorithms. Its slot \code{fit} contains the fitted NMF model as an object #' of class \code{\linkS4class{NMF}}. #' #' Other slots contains data about how the factorization has been computed, #' such as the algorithm and seeding method, the computation time, the final #' residuals, etc\dots{} #' #' Class \code{NMFfit} acts as a wrapper class for its slot \code{fit}. It #' inherits from interface class \code{\linkS4class{NMF}} defined for generic #' NMF models. Therefore, all the methods defined by this interface can be #' called directly on objects of class \code{NMFfit}. The calls are simply #' dispatched on slot \code{fit}, i.e. the results are the same as if calling #' the methods directly on slot \code{fit}. #' #' @slot fit An object that inherits from class \code{\linkS4class{NMF}}, and #' contains the fitted NMF model. #' #' NB: class \code{NMF} is a virtual class. The default class for this #' slot is \code{NMFstd}, that implements the standard NMF model. #' #' @slot residuals A \code{numeric} vector that contains the final #' residuals or the residuals track between the target matrix and its NMF #' estimate(s). Default value is \code{numeric()}. #' #' See method \code{\link{residuals}} for details on accessor methods and main #' interface \code{\link{nmf}} for details on how to compute NMF with residuals #' tracking. #' #' @slot method a single \code{character} string that contains the #' name of the algorithm used to fit the model. #' Default value is \code{''}. #' #' @slot seed a single \code{character} string that contains the #' name of the seeding method used to seed the algorithm that fitted the NMF #' model. #' Default value is \code{''}. See \code{\link{nmf}} for more details. #' #' @slot rng an object that contains the RNG settings used for the #' fit. #' Currently the settings are stored as an integer vector, the value of #' \code{\link{.Random.seed}} at the time the object is created. #' It is initialized by the \code{initialized} method. #' See \code{\link{getRNG}} for more details. #' #' @slot distance either a single \code{"character"} string that #' contains the name of the built-in objective function, or a \code{function} #' that measures the residuals between the target matrix and its NMF estimate. #' See \code{\link{objective}} and \code{\link{deviance,NMF-method}}. #' #' @slot parameters a \code{list} that contains the extra parameters #' -- usually specific to the algorithm -- that were used to fit the model. #' #' @slot runtime object of class \code{"proc_time"} that contains #' various measures of the time spent to fit the model. #' See \code{\link[base]{system.time}} #' #' @slot options a \code{list} that contains the options used to #' compute the object. #' #' @slot extra a \code{list} that contains extra miscellaneous data #' for internal usage only. #' For example it can be used to store extra parameters or temporary data, #' without the need to explicitly extend the \code{NMFfit} class. #' Currently built-in algorithms only use this slot to #' store the number of iterations performed to fit the object. #' #' Data that need to be easily accessible by the end-user should rather be set #' using the methods \code{$<-} that sets elements in the \code{list} slot #' \code{misc} -- that is inherited from class \code{\linkS4class{NMF}}. #' #' @slot call stored call to the last \code{nmf} method that generated the #' object. #' #' @export #' @examples #' # run default NMF algorithm on a random matrix #' n <- 50; r <- 3; p <- 20 #' V <- rmatrix(n, p) #' res <- nmf(V, r) #' #' # result class is NMFfit #' class(res) #' isNMFfit(res) #' #' # show result #' res #' #' # compute summary measures #' summary(res, target=V) #' setClass('NMFfit' , representation( fit = 'NMF', # NMF model residuals = 'numeric', # residuals from the target matrix method = 'character', # method used to compute the factorization seed = 'character', # seeding method used to compute the factorization rng = 'ANY', # numerical random seed distance = '.functionSlotNULL', # method used to compute the distance between the target matrix and its NMF estimate parameters = 'list', # method used to compute the factorization runtime = 'proc_time', # running time to perform the NMF options = 'list', # run options extra = 'list' # extra list of results output by the method , call = 'call' # store last call to nmf() ) , prototype = prototype( residuals = numeric(), method = '', seed = '', parameters = list(), extra = list() ) , validity = function(object){ # slot 'objective' must either be a non-empty character string or a function obj <- objective(object) if( is.character(obj) && obj == '') return(paste("Slot 'objective' must either be a non-empty character string or a function definition", sep='')) # everything went fine: return TRUE TRUE } , contains = 'NMF' ) #' The function \code{NMFfit} is a factory method for NMFfit objects, that should #' not need to be called by the user. #' It is used internally by the functions \code{\link{nmf}} and \code{seed} to #' instantiate the starting point of NMF algorithms. #' #' @param fit an NMF model #' @param ... extra argument used to initialise slots in the instantiating #' \code{NMFfit} object. #' @param rng RNG settings specification (typically a suitable value for #' \code{\link{.Random.seed}}). #' #' @rdname NMFfit-class NMFfit <- function(fit=nmfModel(), ..., rng=NULL){ # use current RNG settings if not otherwise provided if( is.null(rng) ) rng <- getRNG() new('NMFfit', fit=fit, ..., rng=rng) } #' Computes and return the estimated target matrix from an NMF model fitted with #' function \code{\link{nmf}}. #' #' It is a shortcut for \code{fitted(fit(object), ...)}, dispatching the call to #' the \code{fitted} method of the actual NMF model. setMethod('fitted', signature(object='NMFfit'), function(object, ...){ fitted(fit(object), ...) } ) #' Returns the basis matrix from an NMF model fitted with #' function \code{\link{nmf}}. #' #' It is a shortcut for \code{.basis(fit(object), ...)}, dispatching the call to #' the \code{.basis} method of the actual NMF model. setMethod('.basis', signature(object='NMFfit'), function(object, ...){ .basis(fit(object), ...) } ) #' Sets the the basis matrix of an NMF model fitted with #' function \code{\link{nmf}}. #' #' It is a shortcut for \code{.basis(fit(object)) <- value}, dispatching the call to #' the \code{.basis<-} method of the actual NMF model. #' It is not meant to be used by the user, except when developing #' NMF algorithms, to update the basis matrix of the seed object before #' returning it. #' setReplaceMethod('.basis', signature(object='NMFfit', value='matrix'), function(object, value){ .basis(fit(object)) <- value object } ) #' Returns the the coefficient matrix from an NMF model fitted with #' function \code{\link{nmf}}. #' #' It is a shortcut for \code{.coef(fit(object), ...)}, dispatching the call to #' the \code{.coef} method of the actual NMF model. setMethod('.coef', signature(object='NMFfit'), function(object, ...){ .coef(fit(object), ...) } ) #' Sets the the coefficient matrix of an NMF model fitted with #' function \code{\link{nmf}}. #' #' It is a shortcut for \code{.coef(fit(object)) <- value}, dispatching the call to #' the \code{.coef<-} method of the actual NMF model. #' It is not meant to be used by the user, except when developing #' NMF algorithms, to update the coefficient matrix in the seed object before #' returning it. #' setReplaceMethod('.coef', signature(object='NMFfit', value='matrix'), function(object, value){ .coef(fit(object)) <- value object } ) #' Method for single NMF fit objects, which returns the indexes of fixed #' basis terms from the fitted model. setMethod('ibterms', 'NMFfit', function(object){ ibterms(fit(object)) } ) #' Method for single NMF fit objects, which returns the indexes of fixed #' coefficient terms from the fitted model. setMethod('icterms', 'NMFfit', function(object){ icterms(fit(object)) } ) #' Returns the offset from the fitted model. setMethod('offset', signature(object='NMFfit'), function(object){ offset(fit(object)) } ) #' Returns the number of iteration performed to fit an NMF model, typically #' with function \code{\link{nmf}}. #' #' Currently this data is stored in slot \code{'extra'}, but this might change #' in the future. setMethod('niter', signature(object='NMFfit'), function(object, ...){ object@extra$iteration } ) #' Sets the number of iteration performed to fit an NMF model. #' #' This function is used internally by the function \code{\link{nmf}}. #' It is not meant to be called by the user, except when developing #' new NMF algorithms implemented as single function, to set the number #' of iterations performed by the algorithm on the seed, before returning it #' (see \code{\linkS4class{NMFStrategyFunction}}). #' setReplaceMethod('niter', signature(object='NMFfit', value='numeric'), function(object, value){ if( (length(value) != 1) || value < 0 ) stop("NMF::niter - invalid value for 'niter': single non-negative value is required.", call.=FALSE) object@extra$iteration <- value object } ) #' Show method for objects of class \code{NMFfit} setMethod('show', 'NMFfit', function(object) { cat("\n", sep='') cat(" # Model:\n ") s <- capture.output(show(fit(object))) cat(s, sep="\n ") cat(" # Details:\n ") .local <- function(){ if( algorithm(object) != '' ) cat("algorithm: ", algorithm(object), "\n") if( seeding(object) != '' ) cat("seed: ", seeding(object), "\n") # initial RNG stream cat("RNG: ", RNGstr(object), "\n", sep='') # distance/objective function svalue <- objective(object) svalue <- if( is.function(svalue) ) '' else paste("'", svalue,"'", sep='') cat("distance metric: ", svalue, "\n") if( length(residuals(object)) !=0 ) cat("residuals: ", residuals(object), "\n"); # show the miscellaneous result values if( length(object@misc) > 0L ) cat("miscellaneous:", str_desc(object@misc, exdent=12L), ". (use 'misc(object)')\n") # show the parameters specific to the method if( length(object@parameters) > 0 ){ cat("parameters:", str_desc(object@parameters, exdent=12L), "\n") # p <- sapply(object@parameters, function(x){ # if( is.vector(x) && length(x) == 1L ) x # else paste("<", class(x), ">", sep='') # }) # cat(str_wrap(str_out(p, NA, use.names=TRUE, quote=FALSE), exdent=12), "\n") } # show number of iterations if present if( !is.null(i <- niter(object)) ) cat("Iterations:", i, "\n") # show elapsed time if present if( length(runtime(object)) > 0 ){ cat("Timing:\n"); show(runtime(object));} } s <- capture.output(.local()) cat(s, sep="\n ") } ) #' Extracting Fitted Models #' #' The functions \code{fit} and \code{minfit} are S4 genetics that extract #' the best model object and the best fit object respectively, from a collection #' of models or from a wrapper object. #' #' @details #' A fit object differs from a model object in that it contains data about the #' fit, such as the initial RNG settings, the CPU time used, etc\ldots, while #' a model object only contains the actual modelling data such as regression #' coefficients, loadings, etc\ldots #' #' That best model is generally defined as the one that achieves the #' maximum/minimum some quantitative measure, amongst all models in a collection. #' #' In the case of NMF models, the best model is the one that achieves the best #' approximation error, according to the objective function associated with the #' algorithm that performed the fit(s). #' #' @param object an object fitted by some algorithm, e.g. as returned by the #' function \code{\link{nmf}}. #' @param value replacement value #' @param ... extra arguments to allow extension #' #' @rdname fit #' @export setGeneric('fit', function(object, ...) standardGeneric('fit')) #' Returns the NMF model object stored in slot \code{'fit'}. setMethod('fit', 'NMFfit', function(object) slot(object, 'fit')) #' \code{fit<-} sets the fitted model in a fit object. #' It is meant to be called only when developing new NMF algorithms, e.g. to update #' the value of the model stored in the starting point. #' #' @rdname fit #' @export setGeneric('fit<-', function(object, value) standardGeneric('fit<-')) #' Updates the NMF model object stored in slot \code{'fit'} with a new value. setReplaceMethod('fit', signature(object='NMFfit', value='NMF'), function(object, value){ slot(object, 'fit') <- value object # TODO: valid object before returning it (+param check=TRUE or FALSE) } ) #' @rdname fit #' @export setGeneric('minfit', function(object, ...) standardGeneric('minfit') ) #' Returns the object its self, since there it is the result of a single NMF run. setMethod('minfit', 'NMFfit', function(object) object) #' Returns the type of a fitted NMF model. #' It is a shortcut for \code{modelname(fit(object)}. setMethod('modelname', signature(object='NMFfit'), function(object) { modelname(fit(object)) } ) #' Residuals in NMF Models #' #' The package NMF defines methods for the function \code{\link[stats]{residuals}} #' that returns the final residuals of an NMF fit or the track of the residuals #' along the fit process, computed according to the objective function #' associated with the algorithm that fitted the model. #' #' When called with \code{track=TRUE}, the whole residuals track is returned, #' if available. #' Note that method \code{\link{nmf}} does not compute the residuals track, #' unless explicitly required. #' #' It is a S4 methods defined for the associated generic functions from package #' \code{stats} (See \link[stats]{residuals}). #' #' @note Stricly speaking, the method \code{residuals,NMFfit} does not fulfill #' its contract as defined by the package \code{stats}, but rather acts as function #' \code{deviance}. #' The might be changed in a later release to make it behave as it should. #' #' @param object an \code{NMFfit} object as fitted by function \code{\link{nmf}}, #' in single run mode. #' @param ... extra parameters (not used) #' #' @return \code{residuals} returns a single numeric value if \code{track=FALSE} #' or a numeric vector containing the residual values at some iterations. #' The names correspond to the iterations at which the residuals were computed. #' #' @family stats #' @inline #' @rdname residuals #' @export #' setGeneric('residuals', package='stats') #' Returns the residuals -- track -- between the target matrix and the NMF #' fit \code{object}. #' #' @param track a logical that indicates if the complete track of residuals #' should be returned (if it has been computed during the fit), or only the last #' value. #' #' @param niter specifies the iteration number for which one wants #' to get/set/test a residual value. This argument is used only if not \code{NULL} #' setMethod('residuals', 'NMFfit', function(object, track=FALSE, niter=NULL, ...){ ## IMPORTANT: keep this '...' and do not add a 'method' argument as this ## one is passed by NMFfitX::fit (see bug #159) and is not supposed to be ## used res <- slot(object, 'residuals') if( track ) res else if( is.null(niter) ) tail(res, n=1) else res[as.character(niter)] } ) #' \code{residuals<-} sets the value of the last residuals, or, optionally, #' of the complete residual track. #' #' @param value residual value #' #' @export #' @inline #' @rdname residuals setGeneric('residuals<-', function(object, ..., value) standardGeneric('residuals<-') ) #' @inline setReplaceMethod('residuals', 'NMFfit', function(object, ..., niter=NULL, track=FALSE, value){ if( track ) slot(object, 'residuals') <- value else{ if( !is.null(niter) ) value <- setNames(value, niter) slot(object, 'residuals') <- c(slot(object, 'residuals'), value) } object } ) #' Tells if an \code{NMFfit} object contains a recorded residual track. #' #' @export #' @rdname residuals hasTrack <- function(object, niter=NULL){ if( is.null(niter) ) length( slot(object, 'residuals') ) > 1 else !is.na(slot(object, 'residuals')[as.character(niter)]) } #' \code{trackError} adds a residual value to the track of residuals. #' #' @param force logical that indicates if the value should be added to the track #' even if there already is a value for this iteration number or if the iteration #' does not conform to the tracking interval \code{nmf.getOption('track.interval')}. #' #' @rdname residuals #' @export trackError <- function(object, value, niter, force=FALSE){ track <- run.options(object, 'error.track') track.interval <- run.options(object, 'track.interval') if( force || (track && niter %% track.interval == 0) ){ # add the new value to the error track last.iter <- names(residuals(object)) duplicate <- if( !is.null(last.iter) ) niter == last.iter else FALSE if( !duplicate ){ iter <- if( niter >= 0 ) niter residuals(object, niter=iter) <- value } } object } #' Returns the deviance of a fitted NMF model. #' #' This method returns the final residual value if the target matrix \code{y} is #' not supplied, or the approximation error between the fitted NMF model stored #' in \code{object} and \code{y}. #' In this case, the computation is performed using the objective function #' \code{method} if not missing, or the objective of the algorithm that #' fitted the model (stored in slot \code{'distance'}). #' #' If not computed by the NMF algorithm itself, the value is automatically #' computed at the end of the fitting process by the function \code{\link{nmf}}, #' using the objective function associated with the NMF algorithm, so that it #' should always be available. #' #' @inline setMethod('deviance', 'NMFfit', function(object, y, method, ...){ if( missing(y) ) setNames(residuals(object), NULL) else{ # if missing retrieve the actual distance measure from the NMF object if( missing(method) ) method = object@distance # compute the distance between the target and the fitted NMF model deviance(fit(object), y, method=method, ...) } } ) #' Returns the name of the algorithm that fitted the NMF model \code{object}. setMethod('algorithm', 'NMFfit', function(object){ object@method } ) #' @inline setReplaceMethod('algorithm', 'NMFfit', function(object, value){ object@method <- value object } ) #' Returns the name of the seeding method that generated the starting point #' for the NMF algorithm that fitted the NMF model \code{object}. setMethod('seeding', 'NMFfit', function(object){ object@seed } ) #' @inline setReplaceMethod('seeding', 'NMFfit', function(object, value){ object@seed <- value object } ) #' Returns the objective function associated with the algorithm that computed the #' fitted NMF model \code{object}, or the objective value with respect to a given #' target matrix \code{y} if it is supplied. #' #' @param y optional target matrix used to compute the objective value. #' setMethod('objective', signature(object='NMFfit'), function(object, y){ # when both x and y are missing then returns slot objective if( missing(y) ) return(slot(object, 'distance')) # return the distance computed using the strategy's objective function deviance(fit(object), y, method=slot(object, 'distance')) } ) #' @inline setReplaceMethod('objective', signature(object='NMFfit', value='ANY'), function(object, value){ slot(object, 'distance') <- value validObject(object) object } ) #' Returns the CPU time required to compute a single NMF fit. setMethod('runtime', 'NMFfit', function(object, ...){ object@runtime } ) #' Identical to \code{runtime}, since their is a single fit. setMethod('runtime.all', 'NMFfit', getMethod('runtime', 'NMFfit')) ###% Access methods to run options. setGeneric('run.options', function(object, ...) standardGeneric('run.options') ) setMethod('run.options', 'NMFfit', function(object, name){ if( missing(name) ) object@options else object@options[[name]] } ) setGeneric('run.options<-', function(object, ..., value) standardGeneric('run.options<-') ) setReplaceMethod('run.options', 'NMFfit', function(object, ..., value){ params <- list(...) baseError <- 'Setting NMF runtime options: ' if ( length(params) == 0 ){ if( !is.list(value) ) stop(baseError, 'options must be given as a list') object@options <- value return(object) } else if ( length(params) > 1 ) stop(baseError, 'options cannot set more than one option at a time') name <- params[[1]] if( !is.character(name) ) stop(baseError, 'option name must be given as a character string') # check if the option exists #if( !is.element(name, names(nmf.options.runtime())) ) stop(baseError, "option '", name, "' is not defined.") object@options[[name]] <- value object } ) setGeneric('verbose', function(object, ...) standardGeneric('verbose') ) setMethod('verbose', 'NMFfit', function(object){ return(run.options(object, 'verbose') || nmf.getOption('debug')) } ) setGeneric('plot', package='graphics' ) #' Plots the residual track computed at regular interval during the fit of #' the NMF model \code{x}. #' #' @param skip an integer that indicates the number of points to skip/remove from the beginning #' of the curve. #' If \code{skip=1L} (default) only the initial residual -- that is computed before any iteration, is #' skipped, if present in the track (it associated with iteration 0). #' #' @export setMethod('plot', signature(x='NMFfit', y='missing'), function(x, y, skip=-1L, ...){ # retrieve the residuals track track <- residuals(x, track=TRUE) if( length(track) <= 1 ){ warning(class(x), ' object has no residuals track') return(invisible()) } # skip part of the track if( skip == -1L && !is.null(names(track)) ) track <- track[names(track)!='0'] # remove initial residual else if( skip > 0 ) track <- track[-(1:skip)] # set default graphical parameters (those can be overriden by the user) params <- .set.list.defaults(list(...) , xlab='Iterations' , ylab=paste('Objective value (' , if( is.character(x@distance) ) x@distance else algorithm(x), ')' , sep='' ) , main=paste("NMF Residuals\nMethod: ", algorithm(x), " - Rank: ", nbasis(x), sep='') , cex.main = 1 , col='#5555ff', lwd=1.4, type='l', cex=0.5) do.call('plot', c(list(names(track), track), params)) points(names(track), track, type='p', cex=0.6, col=params$col) } ) #' Computes summary measures for a single fit from \code{\link{nmf}}. #' #' This method adds the following measures to the measures computed by the method #' \code{summary,NMF}: #' #' \describe{ #' \item{residuals}{Residual error as measured by the objective function associated #' to the algorithm used to fit the model.} #' \item{niter}{Number of iterations performed to achieve convergence of the algorithm.} #' \item{cpu}{Total CPU time required for the fit.} #' \item{cpu.all}{Total CPU time required for the fit. For \code{NMFfit} objects, this element is #' always equal to the value in \dQuote{cpu}, but will be different for multiple-run fits.} #' \item{nrun}{Number of runs performed to fit the model. This is always equal to 1 for #' \code{NMFfit} objects, but will vary for multiple-run fits.} #' } #' #' @inline #' #' @examples #' # generate a synthetic dataset with known classes: 50 features, 18 samples (5+5+8) #' n <- 50; counts <- c(5, 5, 8); #' V <- syntheticNMF(n, counts) #' cl <- unlist(mapply(rep, 1:3, counts)) #' #' # perform default NMF with rank=2 #' x2 <- nmf(V, 2) #' summary(x2, cl, V) #' # perform default NMF with rank=2 #' x3 <- nmf(V, 3) #' summary(x2, cl, V) #' setMethod('summary', signature(object='NMFfit'), function(object, ...){ res <- summary(fit(object), ...) ## IMPORTANT: if adding a summary measure also add it in the sorting ## schema of method NMFfitX::compare to allow ordering on it # retreive final residuals res <- c(res, residuals=as.numeric(residuals(object))) # nb of iterations res <- c(res, niter=as.integer(niter(object)) ) # runtime t <- runtime(object) utime <- as.numeric(t['user.self'] + t['user.child']) res <- c(res, cpu=utime, cpu.all=utime, nrun=1) # return result return(res) } ) #' Compares two NMF models when at least one comes from a NMFfit object, #' i.e. an object returned by a single run of \code{\link{nmf}}. setMethod('nmf.equal', signature(x='NMFfit', y='NMF'), function(x, y, ...){ nmf.equal(fit(x), y, ...) } ) #' Compares two NMF models when at least one comes from a NMFfit object, #' i.e. an object returned by a single run of \code{\link{nmf}}. setMethod('nmf.equal', signature(x='NMF', y='NMFfit'), function(x, y, ...){ nmf.equal(x, fit(y), ...) } ) #' Compares two fitted NMF models, i.e. objects returned by single runs of #' \code{\link{nmf}}. setMethod('nmf.equal', signature(x='NMFfit', y='NMFfit'), function(x, y, ...){ nmf.equal(fit(x), fit(y), ...) } ) NMF/R/algorithms-pe-nmf.R0000644000176000001440000000367712530703326014615 0ustar ripleyusers#' @include registry-algorithms.R NULL ###% NMF Algorithm: Pattern Expression NMF ###% ###% Implements the PE-NMF algorithm from Zhang et al (2008). ###% ###% It is implemented using the iterative schema defined by the ###% NMFStrategyIterative class. ###% The algorithm minimizes the Frobenius norm, with two regularization terms ###% (one for each matrix factor) parametrized by two parameters: ###% ###% min_{W,H} 1/2 ||V - WH||^2 ###% + alpha \sum_{i<>j} W_i^T W_j ###% + beta \sum_{i,j} H_{ij} ###% ###% So there is two parameters: alpha and beta. ###% The updates for the matrix factors are (in R notations): ###% ###% H_{i+1} = H_i ( W_i^T %*% V ) / ( W_i^T %*% W_i %*% H_i + beta) ###% W_{i+1} = W_i ( V %*% H_i^T ) / ( W_i %*% H_i %*% H_i^T + alpha W_i %*% M ) ###% ###% with matrix M is full of one with diagonal zero. ###% ###% @author Renaud Gaujoux ###% @creation 17 Jan 2010 ###% penmf.objective <- function(fit, x, alpha, beta, ...) { w <- .basis(fit) 1/2 * sum( (x - fitted(fit))^2 ) + alpha * ( crossprod(w) - sum(w^2) ) + beta * sum(.coef(fit)) } nmf_update.penmf <- function(i, x, data, alpha, beta, ...){ # retrieve each factor w <- .basis(data); h <- .coef(data); # At the first iteration initialise matrix M if( TRUE || i == 1 ){ r <- ncol(w) M <- matrix(1, nrow=r, ncol=r) - diag(1, r) #staticVar('M', M, init=TRUE) } #else M <- staticVar('M') #precision threshold for numerical stability eps <- 10^-9 # H_{i+1} = H_i ( W_i^T %*% V ) / ( W_i^T %*% W_i %*% H_i + beta) h <- h * crossprod(w, x) / ( crossprod(w) %*% h + beta) # W_{i+1} = W_i ( V %*% H_i^T ) / ( W_i %*% H_i %*% H_i^T + alpha W_i %*% M ) w <- w * tcrossprod(x, h) / ( w %*% tcrossprod(h) + alpha * w %*% M ) #return the modified data .basis(data) <- w; .coef(data) <- h; data } # register PE-NMF nmfAlgorithm.peNMF <- setNMFMethod('pe-nmf', objective = penmf.objective , model='NMFstd' , Update= nmf_update.penmf , Stop='stationary') NMF/R/algorithms-siNMF.R0000644000176000001440000000635712234465004014404 0ustar ripleyusers# Implementation of siNMF from Badea (2008) # # Author: Renaud Gaujoux # Creation: 09 Jul 2012 ############################################################################### #' @include registry-algorithms.R NULL siNMF_R <- function(i, v, data, beta0=1, scale=TRUE, ...){ # retrieve each factor w <- basis(data); h <- coef(data); # fixed terms nb <- nbterms(data); nc <- ncterms(data) if( i == 1 ){ if( !nc ) stop("Method 'siNMF' requires a formula based model") if( !is.na(beta0) ){ # compute beta gr <- as.numeric(cterms(data)[[1L]]) beta <- beta0 * (norm(v[,gr==1], 'F') / norm(v[,gr==2], 'F'))^2 # make sweeping vector vbeta <- rep(1, ncol(v)) vbeta[gr==2] <- sqrt(beta) staticVar('vbeta', vbeta, init=TRUE) # sweep data staticVar('v', sweep(v, 2L, vbeta, '*', check.margin=FALSE), init=TRUE) } # store non-fixed coef indexes staticVar('icoef', icoef(data), init=TRUE) } #precision threshold for numerical stability eps <- 10^-9 sh <- h if( !is.na(beta0) ){ # retrieved swept matrix sv <- staticVar('v') vbeta <- staticVar('vbeta') # sweep h with beta sh <- sweep(h, 2L, vbeta, '*', check.margin=FALSE) } # compute standard euclidean updates w <- nmf_update.euclidean.w(sv, w, sh, eps=eps, nbterms=nb, ncterms=nc, copy=TRUE) h <- nmf_update.euclidean.h(v, w, h, eps=eps, nbterms=nb, ncterms=nc, copy=TRUE) # normalize columns of w if( scale ){ icoef <- staticVar('icoef') wb <- w[, icoef] d <- sqrt(colSums(wb^2)) w[, icoef] <- sweep(wb, 2L, d, '/') h[icoef, ] <- sweep(h[icoef, ], 1L, d, '*') } .coef(data) <- h .basis(data) <- w data } setNMFMethod('.siNMF', 'lee', Update=siNMF_R) siNMF <- function(i, v, data, beta0=1, scale=TRUE, eps=10^-9, ...){ # retrieve each factor w <- basis(data); h <- coef(data); # fixed terms nb <- nbterms(data); nc <- ncterms(data) if( i == 1 ){ if( !nc ) stop("Method 'siNMF' requires a formula based model") vbeta <- NULL if( !is.na(beta0) ){ # compute beta gr <- cterms(data)[[1L]] gr <- droplevels(gr) # make sweeping vector vbeta <- rep(1, ncol(v)) idx <- split(1:ncol(v), gr) # compute base value from first level beta <- beta0 * norm(v[,idx[[1]]], 'F')^2 vbeta <- lapply(idx[-1], function(j){ rep(beta / norm(v[,j], 'F')^2, length(j)) }) vbeta <- c(rep(1, length(idx[[1]])), unlist(vbeta, use.names=FALSE)) vbeta <- vbeta[order(unlist(idx))] } # store weights staticVar('beta', vbeta, init=TRUE) # store non-fixed coef indexes staticVar('icoef', icoef(data), init=TRUE) } # retrieve weights beta <- staticVar('beta') # compute standard euclidean updates w <- nmf_update.euclidean.w(v, w, h, eps=eps, weight=beta, nbterms=nb, ncterms=nc, copy=FALSE) h <- nmf_update.euclidean.h(v, w, h, eps=eps, nbterms=nb, ncterms=nc, copy=FALSE) # normalize columns of w if( scale ){ icoef <- staticVar('icoef') wb <- w[, icoef] d <- sqrt(colSums(wb^2)) w[, icoef] <- sweep(wb, 2L, d, '/', check.margin=FALSE) h[icoef, ] <- sweep(h[icoef, ], 1L, d, '*', check.margin=FALSE) } .coef(data) <- h .basis(data) <- w data } nmfAlgorithm.siNMF <- setNMFMethod('siNMF', 'lee', Update=siNMF) NMF/R/algorithms-lsnmf.R0000644000176000001440000000606712530710536014547 0ustar ripleyusers# Implementations of LS-NMF # # Reference: # LS-NMF: a modified non-negative matrix factorization algorithm utilizing uncertainty estimates. # Wang, Guoli, Andrew V Kossenkov, and Michael F Ochs. # BMC bioinformatics 7 (January 2006): 175. http://www.ncbi.nlm.nih.gov/pubmed/16569230. # # Author: Renaud Gaujoux # Creation: 09 Nov 2011 ############################################################################### #' @include registry-algorithms.R NULL #' Multiplicative Updates for LS-NMF #' #' Implementation of the updates for the LS-NMF algorithm from \cite{Wang2006}. #' #' @param i current iteration #' @param X target matrix #' @param object current NMF model #' @param weight value for \eqn{\Sigma}{S}, i.e. the weights that are applied to each #' entry in \code{X} by \code{X * weight} (= entry wise product). #' Weights are usually specified as a matrix of the same dimension as \code{X} #' (e.g. uncertainty estimates for each measurement), but may also be passed as a vector, #' in which case the standard rules for entry wise product between matrices and vectors apply #' (e.g. recylcing elements). #' @param eps small number passed to the standard euclidean-based NMF updates #' (see \code{\link{nmf_update.euclidean}}). #' @param ... extra arguments (not used) #' #' @return updated object \code{object} #' @rdname lsNMF-nmf nmf_update.lsnmf <- function(i, X, object, weight, eps=10^-9, ...) { if( i == 1 ){# pre-compute weighted target matrix staticVar('wX', X * weight, init=TRUE) } # retrieve weighted target matrix wX <- staticVar('wX') # retrieve each factor w <- .basis(object); h <- .coef(object); # compute the estimate WH wh <- fitted(object) * weight # euclidean-reducing NMF iterations # H_au = H_au (W^T V/sigma)_au / (W^T (W H)/sigma)_au h <- nmf_update.euclidean.h_R(wX, w, h, wh=wh, eps=eps) # update H and recompute the estimate WH .coef(object) <- h; wh <- fitted(object) * weight # W_ia = W_ia (V/sigma H^T)_ia / ((W H)/sigma H^T)_ia and columns are rescaled after each iteration w <- nmf_update.euclidean.w_R(wX, w, h, wh=wh, eps=eps) #return the modified data .basis(object) <- w return(object) } #' \code{wrss} implements the objective function used by the LS-NMF algorithm. #' #' @rdname lsNMF-nmf wrss <- function(object, X, weight){ sum( ((X - fitted(object)) * weight)^2 )/2 } # Registration of LS-NMF #' @inheritParams run,NMFStrategyIterative,matrix,NMFfit-method #' @inheritParams nmf.stop.stationary #' #' @aliases lsNMF-nmf #' @rdname lsNMF-nmf nmfAlgorithm.lsNMF <- setNMFMethod('ls-nmf', objective=wrss , Update=nmf_update.lsnmf , Stop='stationary') # Unit test for the LS-NMF algorithm runit.lsnmf <- function(){ requireNamespace('RUnit') set.seed(12345) X <- rmatrix(100,20) res <- nmf(X, 3, 'ls-nmf', weight=1, seed=1) res2 <- nmf(X, 3, '.R#lee', rescale=FALSE, seed=1, .stop=nmf.stop.stationary) tol <- 10^-14 RUnit::checkTrue( nmf.equal(res, res2, identical=FALSE, tol=tol ), paste("LS-NMF with weight = 1 and .R#Lee (no scale + stationary) give identical results at tolerance=", tol)) } NMF/R/heatmaps.R0000644000176000001440000004403112234465004013052 0ustar ripleyusers# Heatmap functions # # Author: Renaud Gaujoux ############################################################################### #' @include NMF-class.R #' @include aheatmap.R NULL #' @param object an R object #' @param ... other arguments #' #' @export #' @inline #' @rdname NMF-defunct setGeneric('metaHeatmap', function(object, ...) standardGeneric('metaHeatmap') ) #' Defunct method substituted by \code{\link{aheatmap}}. setMethod('metaHeatmap', signature(object='matrix'), function(object, ...){ local <- function(object, type=c('plain', 'consensus'), class , unit.scaling=c('none', 'row', 'column'), palette="YlOrRd" , rev.palette=FALSE, show.prediction=TRUE, ...){ .Defunct('metaHeatmap', 'NMF', "The S4 method 'metaHeatmap,matrix' is defunct, use 'aheatmap' instead.") # # load libary RColorBrewer # library(RColorBrewer) # # # retreive the graphical parameters and match them to the sub-sequent call to 'heatmap.plus.2' # graphical.params <- list(...) # names(graphical.params) <- .match.call.args(names(graphical.params), 'heatmap.plus.2', in.fun='metaHeatmap', call='NMF::metaHeatmap') # # type <- match.arg(type) # if( type == 'consensus' ){ # # set default graphical parameters for type 'consensus' # graphical.params <- .set.list.defaults(graphical.params # , distfun = function(x){ as.dist(1-x) } # , main='Consensus matrix' # , symm=TRUE # , Rowv=TRUE # , revC=TRUE # ) # # if( missing(palette) ) palette <- 'RdYlBu' # if( missing(rev.palette) ) rev.palette <- TRUE # if( missing(unit.scaling) ) unit.scaling <- 'none' # show.prediction <- FALSE # not used for consensus matrices # } # # # apply unit scaling if necessary # unit.scaling <- match.arg(unit.scaling) # if( unit.scaling == 'column' ) # object <- apply(object, 2, function(x) x/sum(x)) # else if ( unit.scaling == 'row' ) # object <- t(apply(object, 1, function(x) x/sum(x))) # # # check validity of palette # col.palette <- brewer.pal(brewer.pal.info[palette,'maxcolors'],palette) # if( rev.palette ) col.palette <- rev(col.palette) # # # set default graphical parameters (if those are not already set) # graphical.params <- .set.list.defaults(graphical.params # , cexRow=0.8, cexCol=0.8 # , hclustfun = function(m) hclust(m,method="average") # , dendrogram='none' # , col=col.palette # , scale='none', trace="none" # , keysize=1, margins=c(5,10) # ) # # # if a known class is provided, add a side color over the top row # if( !missing(class) ){ # if( !is.factor(class) ) class <- as.factor(class) # class.num <- as.numeric(class) # legend.pal <- palette(rainbow(max(2,nlevels(class))))[1:nlevels(class)] # col.matrix <- matrix(legend.pal[class.num], ncol(object), 1) # # # show association with metagenes # if( show.prediction ){ # # only if there is less than 9 metagenes # # cf. limitation of brewer color palette # if( nrow(object) <= 9 ){ # prediction <- .predict.nmf(object) # prediction.num <- as.numeric(prediction) # pal.pred <- brewer.pal(max(3,nrow(object)),'Set2')[1:nrow(object)] # col.matrix <- cbind(pal.pred[prediction.num], col.matrix) # graphical.params <- .set.list.defaults(graphical.params # , RowSideColors=pal.pred # ) # } # else warning("NMF::metaHeatmap - cannot not show prediction for more than 9 metagenes.") # } # # do that otherwise heatmap.plus complains # if( ncol(col.matrix) < 2 ) # col.matrix <- cbind(col.matrix, col.matrix) # # # add the ColSideColors # graphical.params <- .set.list.defaults(graphical.params # , ColSideColors=col.matrix # ) # } # # # res.heatmap <- do.call('heatmap.plus.2', c(list(object), graphical.params)) # # if( !missing(class) ){ # # order properly the legend boxes # class.num <- as.numeric(class[res.heatmap$colInd]) # # occ <- NA # will store the current number of occurences # class.max.occ <- rep(0, nlevels(class)) # will store the current maximum number of occurences per class # class.start <- rep(NA, nlevels(class)) # will store the current start of the longer stretch per class # last.l <- '' # sapply( seq(length(class.num), 1, -1), # function(i){ # l <- class.num[i] # if(l==last.l){ # occ <<- occ + 1 # }else{ # occ <<- 1 # } # if(occ > class.max.occ[l]){ # class.max.occ[l] <<- occ # class.start[l] <<- i # } # last.l <<- l # } # ) # # class.ord <- order(class.start) # l.names <- levels(class)[class.ord] # l.color <- legend.pal[class.ord] # legend('top', title='Classes' # , legend=l.names, fill=l.color # , horiz=TRUE, bty='n') # } # # # return invisible # invisible(res.heatmap) } local(object, ...) } ) #' Deprecated method that is substituted by \code{\link{coefmap}} and \code{\link{basismap}}. setMethod('metaHeatmap', signature(object='NMF'), function(object, ...){ local <- function(object, what=c('samples', 'features'), filter=FALSE, ...){ what <- match.arg(what) if( what == 'samples' ){ # send deprecated warning .Defunct('coefmap', 'NMF', "Direct use of the S4-Method 'metaHeatmap' for 'NMF' objects is defunct, use 'coefmap' instead.") # call the new function 'coefmap' return( coefmap(object, ...) ) }else if( what == 'features' ){ # send deprecated warning .Defunct('basismap', 'NMF', "Direct use of the S4-Method 'metaHeatmap' for 'NMF' objects is defunct, use 'basismap' instead.") # call the new function 'basismap' return( basismap(object, subsetRow=filter, ...) ) } } local(object, ...) } ) # match an annotation track against list of supported tracks match_named_track <- function(annotation, tracks, msg, optional=FALSE){ idx <- if( is.character(annotation) ){ i <- match(annotation, tracks, nomatch=if(optional) 0L else NA ) if( any(!is.na(i)) ){ if( !optional && any(is.na(i)) ){ stop(msg, "invalid track(s) [", str_out(annotation[is.na(i)]) , "]: should be one of ", str_out(tracks)) } } i }else if( is.list(annotation) ){ sapply(annotation, function(x){ if( isString(x) ) match(x, tracks, nomatch=if(optional) 0L else NA ) else NA }) } if( is.null(idx) ) return() ok <- !is.na(idx) # result # remaining annotations ann <- annotation[!ok] if( length(ann) == 0L ) ann <- NULL # track annotations tr <- unlist(annotation[which(ok)]) idx <- idx[which(ok)] if( is.null(names(annotation)) ) names(tr) <- tr else{ mn <- names(tr) == '' names(tr)[mn] <- tr[mn] } others <- tr[idx==0L] # # list(ann=ann, tracks=tr[idx>0L], others=if(length(others)) others else NULL) list(ann=as.list(ann), tracks=tr) } #' Heatmaps of NMF Factors #' #' The NMF package ships an advanced heatmap engine implemented by the function #' \code{\link{aheatmap}}. #' Some convenience heatmap functions have been implemented for NMF models, #' which redefine default values for some of the arguments of \code{\link{aheatmap}}, #' hence tuning the output specifically for NMF models. #' #' \strong{IMPORTANT:} although they essentially have the same set of arguments, #' their order sometimes differ between them, as well as from \code{\link{aheatmap}}. #' We therefore strongly recommend to use fully named arguments when calling these functions. #' #' @rdname heatmaps #' @name heatmap-NMF #' #' @examples #' #' ## More examples are provided in demo `heatmaps` #' \dontrun{ #' demo(heatmaps) #' } #' ## #' #' # random data with underlying NMF model #' v <- syntheticNMF(20, 3, 10) #' # estimate a model #' x <- nmf(v, 3) #' #' @demo Heatmaps of NMF objects #' #' #' # random data with underlying NMF model #' v <- syntheticNMF(20, 3, 10) #' # estimate a model #' x <- nmf(v, 3) #' NULL #' \code{basimap} draws an annotated heatmap of the basis matrix. #' #' @details #' \code{basimap} default values for the following arguments of \code{\link{aheatmap}}: #' \itemize{ #' \item the color palette; #' \item the scaling specification, which by default scales each #' row separately so that they sum up to one (\code{scale='r1'}); #' \item the column ordering which is disabled; #' \item allowing for passing feature extraction methods in argument #' \code{subsetRow}, that are passed to \code{\link{extractFeatures}}. #' See argument description here and therein. #' \item the addition of a default named annotation track, that shows #' the dominant basis component for each row (i.e. each feature). #' #' This track is specified in argument \code{tracks} (see its argument description). #' By default, a matching column annotation track is also displayed, but may be #' disabled using \code{tracks=':basis'}. #' #' \item a suitable title and extra information like the fitting algorithm, #' when \code{object} is a fitted NMF model. #' } #' #' @param object an object from which is extracted NMF factors or a consensus #' matrix #' @param ... extra arguments passed to \code{\link{aheatmap}}. #' #' @rdname heatmaps #' @inline #' @export #' #' @examples #' #' # show basis matrix #' basismap(x) #' \dontrun{ #' # without the default annotation tracks #' basismap(x, tracks=NA) #' } #' #' @demo #' #' # highligh row only (using custom colors) #' basismap(x, tracks=':basis', annColor=list(basis=1:3)) #' #' ## character annotation vector: ok if it does not contain 'basis' #' # annotate first and second row + automatic special track #' basismap(x, annRow=c('alpha', 'beta')) #' # no special track here #' basismap(x, annRow=c('alpha', 'beta', ':basis'), tracks=NA) #' # with special track `basis` #' basismap(x, annRow=list(c('alpha', 'beta'), ':basis'), tracks=NA) #' # highligh columns only (using custom colors) #' basismap(x, tracks='basis:') #' #' # changing the name of the basis annotation track #' basismap(x, annRow=list(new_name=':basis')) #' setGeneric('basismap', function(object, ...) standardGeneric('basismap') ) #' Plots a heatmap of the basis matrix of the NMF model \code{object}. #' This method also works for fitted NMF models (i.e. \code{NMFfit} objects). #' #' @inheritParams aheatmap #' @param subsetRow Argument that specifies how to filter the rows that #' will appear in the heatmap. #' When \code{FALSE} (default), all rows are used. #' Besides the values supported by argument \code{subsetRow} of #' \code{\link{aheatmap}}, other possible values are: #' #' \itemize{ #' \item \code{TRUE}: only the rows that are basis-specific are used. #' The default selection method is from \cite{KimH2007}. #' This is equivalent to \code{subsetRow='kim'}. #' #' \item a single \code{character} string or numeric value that specifies #' the method to use to select the basis-specific rows, that should appear in the #' heatmap (cf. argument \code{method} for function \code{\link{extractFeatures}}). #' #' Note \code{\link{extractFeatures}} is called with argument \code{nodups=TRUE}, #' so that features that are selected for multiple components only appear once. #' } #' @param tracks Special additional annotation tracks to highlight associations between #' basis components and sample clusters: #' \describe{ #' \item{basis}{matches each row (resp. column) to the most contributing basis component #' in \code{basismap} (resp. \code{coefmap}). #' In \code{basismap} (resp. \code{coefmap}), adding a track \code{':basis'} to #' \code{annCol} (resp. \code{annRow}) makes the column (resp. row) corresponding to #' the component being also highlited using the mathcing colours.} #' } #' @param info if \code{TRUE} then the name of the algorithm that fitted the NMF #' model is displayed at the bottom of the plot, if available. #' Other wise it is passed as is to \code{aheatmap}. #' #' setMethod('basismap', signature(object='NMF'), function(object, color = 'YlOrRd:50' , scale = 'r1' , Rowv=TRUE, Colv=NA, subsetRow=FALSE , annRow=NA, annCol=NA, tracks = 'basis' , main="Basis components", info = FALSE , ...){ # resolve subsetRow if its a single value if( is.atomic(subsetRow) && length(subsetRow) == 1 ){ subsetRow <- if( isFALSE(subsetRow) ) NULL else if( isTRUE(subsetRow) ) # use Kim and Park scoring scheme for filtering extractFeatures(object, format='combine') else if( is.character(subsetRow) || is.numeric(subsetRow) ) # use subsetRow as a filtering method extractFeatures(object, method=subsetRow, format='combine') else stop("NMF::basismap - invalid single value for argument 'subsetRow' [logical, numeric or character expected]") } # extract the basis vector matrix x <- basis(object) # add side information if requested info <- if( isTRUE(info) && isNMFfit(object) ) paste("Method:", algorithm(object)) else if( isFALSE(info) ) NULL else info # process annotation tracks ptracks <- process_tracks(x, tracks, annRow, annCol) annRow <- ptracks$row annCol <- ptracks$col # set special annotation handler specialAnnotation(1L, 'basis', function() predict(object, what='features')) specialAnnotation(2L, 'basis', function() as.factor(1:nbasis(object))) # # call aheatmap on matrix aheatmap(x, color = color, ... , scale = scale, Rowv=Rowv, Colv = Colv, subsetRow = subsetRow , annRow = annRow, annCol = annCol , main = main, info = info) } ) # check if an object contains some value anyValue <- function(x){ length(x) > 0L && !is_NA(x) } grep_track <- function(x){ list( both = grepl("^[^:].*[^:]$", x) | grepl("^:.*:$", x) , row = grepl("^:.*[^:]$", x) , col = grepl("^[^:].*:$", x) ) } # process extra annotation tracks process_tracks <- function(data, tracks, annRow=NA, annCol=NA){ if( anyValue(tracks) ){ # extract choices from caller function formal.args <- formals(sys.function(sys.parent())) choices <- eval(formal.args[[deparse(substitute(tracks))]]) if( isTRUE(tracks) ) tracks <- choices else{ if( !is.character(tracks) ) stop("Special annotation tracks must be specified either as NA, TRUE or a character vector [", class(tracks), "].") # check validity pattern <- "^(:)?([^:]*)(:)?$" basech <- str_match(choices, pattern) basetr <- str_match(tracks, pattern) tr <- basetr[, 3L] # print(basetr) # print(basech) # extend base track name i <- charmatch(tr, basech[,3L]) tr[!is.na(i)] <- basech[i[!is.na(i)],3L] tracks_long <- str_c(basetr[,2L], tr, basetr[,4L]) # extend choices tty_choice <- grep_track(choices) if( any(tty_choice$both) ) choices <- c(choices, str_c(':', choices[tty_choice$both]), str_c(choices[tty_choice$both], ':')) # look for exact match itr <- charmatch(tracks_long, choices) if( length(err <- which(is.na(itr))) ){ stop("Invalid special annotation track name [", str_out(tracks[err], Inf) ,"]. Should partially match one of ", str_out(choices, Inf), '.') } tracks[!is.na(itr)] <- choices[itr] } # print(tracks) } # tty <- grep_track(tracks) # create result object build <- function(x, ann, data, margin){ t <- if( anyValue(x) ) as.list(setNames(str_c(':', sub("(^:)|(:$)","",x)), names(x))) else NA # build annotations atrack(ann, t, .DATA=amargin(data,margin)) } res <- list() res$row <- build(tracks[tty$both | tty$row], annRow, data, 1L) res$col <- build(tracks[tty$both | tty$col], annCol, data, 2L) #str(res) res } #' \code{coefmap} draws an annotated heatmap of the coefficient matrix. #' #' @details #' \code{coefmap} redefines default values for the following arguments of #' \code{\link{aheatmap}}: #' \itemize{ #' \item the color palette; #' \item the scaling specification, which by default scales each #' column separately so that they sum up to one (\code{scale='c1'}); #' \item the row ordering which is disabled; #' \item the addition of a default annotation track, that shows the most #' contributing basis component for each column (i.e. each sample). #' #' This track is specified in argument \code{tracks} (see its argument description). #' By default, a matching row annotation track is also displayed, but can be disabled #' using \code{tracks='basis:'}. #' \item a suitable title and extra information like the fitting algorithm, #' when \code{object} is a fitted NMF model. #' } #' #' @rdname heatmaps #' @inline #' @export #' #' @examples #' #' # coefficient matrix #' coefmap(x) #' \dontrun{ #' # without the default annotation tracks #' coefmap(x, tracks=NA) #' } #' #' @demo #' #' # coefficient matrix #' coefmap(x, annCol=c('alpha', 'beta')) # annotate first and second sample #' coefmap(x, annCol=list('basis', Greek=c('alpha', 'beta'))) # annotate first and second sample + basis annotation #' coefmap(x, annCol=c(new_name='basis')) #' setGeneric('coefmap', function(object, ...) standardGeneric('coefmap') ) #' The default method for NMF objects has special default values for #' some arguments of \code{\link{aheatmap}} (see argument description). setMethod('coefmap', signature(object='NMF'), function(object, color = 'YlOrRd:50' , scale = 'c1' , Rowv = NA, Colv = TRUE , annRow = NA, annCol = NA, tracks='basis' , main="Mixture coefficients", info = FALSE , ...){ # use the mixture coefficient matrix x <- coef(object) # add side information if requested info <- if( isTRUE(info) && isNMFfit(object) ) paste("Method: ", algorithm(object)) else if( isFALSE(info) ) NULL else info # process annotation tracks ptracks <- process_tracks(x, tracks, annRow, annCol) annRow <- ptracks$row annCol <- ptracks$col # set special annotation handler specialAnnotation(1L, 'basis', function() as.factor(1:nbasis(object))) specialAnnotation(2L, 'basis', function() predict(object)) # ## process ordering if( isString(Colv) ){ if( Colv == 'basis' ) Colv <- 'samples' if( Colv == 'samples' ) Colv <- order(as.numeric(predict(object, Colv))) } ## # call aheatmap on matrix aheatmap(x, ..., color = color , scale = scale, Rowv = Rowv, Colv=Colv , annRow=annRow, annCol = annCol , main=main, info = info) } ) NMF/R/tests.R0000644000176000001440000000223012234465004012405 0ustar ripleyusers# Utility functions to test NMF algorithms # # Author: Renaud Gaujoux # Created: 29 Nov 2012 ############################################################################### #' @include rmatrix.R NULL #' Checking NMF Algorithm #' #' \code{nmfCheck} enables to quickly check that a given NMF algorithm runs #' properly, by applying it to some small random data. #' #' @param method name of the NMF algorithm to be tested. #' @param rank rank of the factorization #' @param x target data. If \code{NULL}, a random 20 x 10 matrix is generated #' @param seed specifies a seed or seeding method for the computation. #' @param ... other arguments passed to the call to \code{\link{nmf}}. #' #' @return the result of the NMF fit invisibly. #' #' @export #' @examples #' #' # test default algorithm #' nmfCheck() #' #' # test 'lee' algorithm #' nmfCheck('lee') #' nmfCheck <- function(method=NULL, rank=max(ncol(x)/5, 3), x=NULL, seed=1234, ...){ # seed computation if( isNumber(seed) ){ os <- RNGseed() on.exit( RNGseed(os), add=TRUE) set.seed(seed) seed <- NULL } if( is.null(x) ){ x <- rmatrix(20, 10) } res <- nmf(x, rank, method, seed=seed, ...) } NMF/vignettes/0000755000176000001440000000000012530712567012742 5ustar ripleyusersNMF/vignettes/heatmaps.Rnw0000644000176000001440000004455212234465004015236 0ustar ripleyusers%\VignetteIndexEntry{NMF: generating heatmaps} %\VignetteDepends{utils,NMF,RColorBrewer,knitr,bibtex} %\VignetteKeyword{aplot} %\VignetteCompiler{knitr} %\VignetteEngine{knitr::knitr} \documentclass[a4paper]{article} %\usepackage[OT1]{fontenc} \usepackage[colorlinks]{hyperref} \usepackage{a4wide} \usepackage{xspace} \usepackage[all]{hypcap} % for linking to the top of the figures or tables % add preamble from pkgmaker <>= pkgmaker::latex_preamble() @ \newcommand{\nmfpack}{\pkgname{NMF}} \newcommand{\MATLAB}{MATLAB\textsuperscript{\textregistered}\xspace} \newcommand{\refeqn}[1]{(\ref{#1})} % REFERENCES \usepackage[citestyle=authoryear-icomp , doi=true , url=true , maxnames=1 , maxbibnames=15 , backref=true , backend=bibtex]{biblatex} \AtEveryCitekey{\clearfield{url}} <>= pkgmaker::latex_bibliography('NMF') @ \newcommand{\citet}[1]{\textcite{#1}} \renewcommand{\cite}[1]{\parencite{#1}} \DefineBibliographyStrings{english}{% backrefpage = {see p.}, % for single page number backrefpages = {see pp.} % for multiple page numbers } % % boxed figures \usepackage{float} \floatstyle{boxed} \restylefloat{figure} \usepackage{array} \usepackage{tabularx} \usepackage{mathabx} \usepackage{url} \urlstyle{rm} % use cleveref for automatic reference label formatting \usepackage[capitalise, noabbrev]{cleveref} % define commands for notes \usepackage{todonotes} \newcommand{\nbnote}[1]{\ \bigskip\todo[inline, backgroundcolor=blue!20!white]{\scriptsize\textsf{\textbf{NB:} #1}}\ \\} % put table of contents on two columns \usepackage[toc]{multitoc} \setkeys{Gin}{width=0.95\textwidth} \begin{document} <>= #options(prompt=' ') #options(continue=' ') set.seed(123456) library(NMF) @ \title{Generating heatmaps for Nonnegative Matrix Factorization\\ \small Package \nmfpack\ - Version \Sexpr{utils::packageVersion('NMF')}} \author{Renaud Gaujoux} \maketitle \begin{abstract} This vignette describes how to produce different informative heatmaps from NMF objects, such as returned by the function \code{nmf} in the \citeCRANpkg{NMF}. The main drawing engine is implemented by the function \code{aheatmap}, which is a highly enhanced modification of the function \code{pheatmap} from the \CRANpkg{pheatmap}, and provides convenient and quick ways of producing high quality and customizable annotated heatmaps. Currently this function is part of the package \nmfpack, but may eventually compose a separate package on its own. \end{abstract} {\small \tableofcontents} \section{Preliminaries} \subsection{Quick reminder on NMF models} Given a nonnegative target matrix $X$ of dimension $n\times p$, NMF algorithms aim at finding a rank $k$ approximation of the form: $$ X \approx W H, $$ where $W$ and $H$ are nonnegative matrices of dimensions $n\times k$ and $k\times p$ respectively. The matrix $W$ is the basis matrix, whose columns are the basis components. The matrix $H$ is the mixture coefficient or weight matrix, whose columns contain the contribution of each basis component to the corresponding column of $X$. We call the rows of $H$ the basis profiles. \subsection{Heatmaps for NMF} Because NMF objects essentially wrap up a pair of matrices, heatmaps are convenient to visualise the results of NMF runs. The package \nmfpack provides several specialised heatmap functions, designed to produce heatmaps with sensible default configurations according to the data being drawn. Being all based on a common drawing engine, they share almost identical interfaces and capabilities. The following specialised functions are currently implemented: \begin{description} \item[\code{basismap}] draws heatmaps of the basis matrix \item[\code{coefmap}] draws heatmaps of the mixture coefficient matrix \item[\code{consensusmap}] draws heatmaps of the consensus matrix, for results of multiple NMF runs. \end{description} \subsection{Heatmap engine} All the above functions eventually call a common heatmap engine, with different default parameters, chosen to be relevant for the given underlying data. The engine is implemented by the function \code{aheatmap}. Its development started as modification of the function \code{pheatmap} from the \pkgname{pheatmap} package. The initial objective was to improve and increase its capabilities, as well as defining a simplified interface, more consistent with the R core function \code{heatmap}. We eventually aim at providing a general, flexible, powerful and easy to use engine for drawing annotated heatmaps. The function \code{aheatmap} has many advantages compared to other heatmap functions such as \code{heatmap}, \code{gplots::heatmap2}, \code{heatmap.plus::heatmap.plus} , or even \code{pheatmap}: \begin{itemize} \item Annotations: unlimited number of annotation tracks can be added to \emph{both} columns and rows, with automated colouring for categorical and numeric variables. \item Compatibility with both base and grid graphics: the function can be directly called in drawing contexts such as grid, mfrow or layout. This is a feature many R users were looking for, and that was strictly impossible with base heatmaps. \item Legends: default automatic legend and colouring; \item Customisation: clustering methods, annotations, colours and legend can all be customised, even separately for rows and columns; \item Convenient interface: many arguments provide multiple ways of specifying their value(s), which speeds up developping/writing and reduce the amount of code required to generate customised plots (e.g. see \cref{sec:colour_spec}). \item Aesthetics: the heatmaps look globally cleaner, the image and text components are by default well proportioned relatively to each other, and all fit within the graphic device. \end{itemize} \subsection{Data and model} \label{sec:data} For the purpose of illustrating the use of each heatmap function, we generate a random target matrix, as well as some annotations or covariates: <>= # random data that follow an 3-rank NMF model (with quite some noise: sd=2) X <- syntheticNMF(100, 3, 20, noise=2) # row annotations and covariates n <- nrow(X) d <- rnorm(n) e <- unlist(mapply(rep, c('X', 'Y', 'Z'), 10)) e <- c(e, rep(NA, n-length(e))) rdata <- data.frame(Var=d, Type=e) # column annotations and covariates p <- ncol(X) a <- sample(c('alpha', 'beta', 'gamma'), p, replace=TRUE) # define covariates: true groups and some numeric variable c <- rnorm(p) # gather them in a data.frame covariates <- data.frame(a, X$pData, c) @ %\SweaveOpts{fig.width=14,fig.height=7} <>= library(knitr) opts_chunk$set(fig.width=14, fig.height=7) @ Note that in the code above, the object \code{X} returned by \code{syntheticNMF} \emph{really is} a matrix object, but wrapped through the function \code{ExposedAttribute} object, which exposes its attributes via a more friendly and access controlled interface \code{\$}. Of particular interests are attributes \code{'pData'} and \code{'fData'}, which are lists that contain a factor named \code{'Group'} that indicates the true underlying clusters. These are respectively defined as each sample's most contrbuting basis component and the basis component to which each feature contributes the most. They are useful to annotate heatmaps and assess the ability of NMF methods to recover the true clusters. As an example, one can conveniently visualize the target matrix as a heatmap, with or without the relevant sample and feature annotations, using simple calls to the \code{aheatmap} function: <>= par(mfrow=c(1,2)) aheatmap(X, annCol=covariates, annRow=X$fData) aheatmap(X) @ Then, we fit an NMF model using multiple runs, that will be used throughtout this vignette to illustrate the use of NMF heatmaps: <>= res <- nmf(X, 3, nrun=10) res @ \nbnote{To keep the vignette simple, we always use the default NMF method (i.e. \code{'brunet'}), but all steps could be performed using a different method, or multiple methods in order to compare their perfromances.} \section{Mixture Coefficient matrix: \texttt{coefmap}} The coefficient matrix of the result can be plotted using the function \code{coefmap}. The default behaviour for multiple NMF runs is to add two annotation tracks that show the clusters obtained by the best fit and the hierarchical clustering of the consensus matrix\footnote{The hierarchical clustering is computed using the consensus matrix itself as a similarity measure, and average linkage. See \code{?consensushc}.}. In the legend, these tracks are named \emph{basis} and \emph{consensus} respectively. For single NMF run or NMF model objects, no consensus data are available, and only the clusters from the fit are displayed. <>= opar <- par(mfrow=c(1,2)) # coefmap from multiple run fit: includes a consensus track coefmap(res) # coefmap of a single run fit: no consensus track coefmap(minfit(res)) par(opar) @ \nbnote{Note how both heatmaps were drawn on the same plot, simply using the standard call to \code{par(mfrow=c(1,2)}. This is impossible to achieve with the R core function \code{heatmap}. See \cref{sec:aheatmap} for more details about compatibility with base and grid graphics.} By default: \begin{itemize} \item the rows are not ordered; \item the columns use the default ordering of \code{aheatmap}, but may easily be ordered according to the clusters defined by the dominant basis component for each column with \code{Colv="basis"}, or according to those implied by the consensus matrix, i.e. as in \code{consensusmap}, with \code{Colv="consensus"}; \item each column is scaled to sum up to one; \item the color palette used is \code{'YlOrRd'} from the \citeCRANpkg{RColorBrewer}, with 50 breaks. \end{itemize} In term of arguments passed to the heatmap engine \code{aheatmap}, these default settings translate as: <>= Rowv = NA Colv = TRUE scale = 'c1' color = 'YlOrRd:50' annCol = predict(object) + predict(object, 'consensus') @ If the ordering does not come from a hierarchical clustering (e.g., if \code{Colv='basis'}), then no dendrogram is displayed. The default behaviour of \code{aheatmap} can be obtained by setting arguments \code{Rowv=TRUE, Colv=TRUE, scale='none'}. \medskip The automatic annotation tracks can be hidden all together by setting argument \code{tracks=NA}, displayed separately by passing only one of the given names (e.g. \code{tracks=':basis'} or \code{tracks='basis:'} for the row or column respectively), and their legend names may be changed by specifying e.g. \code{tracks=c(Metagene=':basis', 'consensus')}. Beside this, they are handled by the heatmap engine function \code{aheatmap} and can be customised as any other annotation tracks -- that can be added via the same argument \code{annCol} (see \cref{sec:aheatmap} or \code{?aheatmap} for more details). <>= opar <- par(mfrow=c(1,2)) # removing all automatic annotation tracks coefmap(res, tracks=NA) # customized plot coefmap(res, Colv = 'euclidean' , main = "Metagene contributions in each sample", labCol = NULL , annRow = list(Metagene=':basis'), annCol = list(':basis', Class=a, Index=c) , annColors = list(Metagene='Set2') , info = TRUE) par(opar) @ \nbnote{The feature that allows to display some information about the fit at the bottom of the plot via argument \code{info=TRUE} is still experimental. It is helpful mostly when developing algorithms or doing an analysis, but would seldom be used in publications.} \section{Basis matrix: \texttt{basismap}} The basis matrix can be plotted using the function \code{basismap}. The default behaviour is to add an annotation track that shows for each row the dominant basis component. That is, for each row, the index of the basis component with the highest loading. This track can be disabled by setting \code{tracks=NA}, and extra row annotations can be added using the same argument \code{annRow}. <>= opar <- par(mfrow=c(1,2)) # default plot basismap(res) # customized plot: only use row special annotation track. basismap(res, main="Metagenes", annRow=list(d, e), tracks=c(Metagene=':basis')) par(opar) @ By default: \begin{itemize} \item the columns are not ordered; \item the rows are ordered by hierarchical clustering using default distance and linkage methods (\code{'eculidean'} and \code{'complete'}); \item each row is scaled to sum up to one; \item the color palette used is \code{'YlOrRd'} from the \citeCRANpkg{RColorBrewer}, with 50 breaks. \end{itemize} In term of arguments passed to the heatmap engine \code{aheatmap}, these default settings translate as: <>= Colv = NA scale = 'r1' color = 'YlOrRd:50' annRow = predict(object, 'features') @ \section{Consensus matrix: \texttt{consensusmap}} When doing clustering with NMF, a common way of assessing the stability of the clusters obtained for a given rank is to consider the consensus matrix computed over multiple independent NMF runs, which is the average of the connectivity matrices of each separate run \footnote{Hence, stability here means robustness with regards to the initial starting point, and shall not be interpreted as in e.g. cross-validation/bootstrap analysis. However, one can argue that having very consistent clusters across runs somehow supports for a certain regularity or the presence of an underlying pattern in the data.}. This procedure is usually repeated over a certain range of factorization ranks, and the results are compared to identify which rank gives the best clusters, possibly in the light of some extra knowledge one could have about the samples (e.g. covariates). The functions \code{nmf} and \code{consensusmap} make it easy to implement this whole process. \nbnote{The consensus plots can also be generated for fits obtained from single NMF runs, in which case the consensus matrix simply reduces to a single connectivity matrix. This is a binary matrix (i.e. entries are either 0 or 1), that will always produce a bi-colour heatmap, and by default clear blocks for each cluster.} \subsection{Single fit} In section \cref{sec:data}, the NMF fit \code{res} was computed with argument \code{nrun=10}, and therefore contains the best fit over 10 runs, as well as the consensus matrix computed over all the runs \footnote{If one were interested in keeping the fits from all the runs, the function \code{nmf} should have been called with argument \code{.options='k'}. See section \emph{Options} in \code{?nmf}. The downstream hanlding of the result would remain identical.}. This can be ploted using the function \code{consensusmap}, which allows for the same kind of customization as the other NMF heatmap functions: <>= opar <- par(mfrow=c(1,2)) # default plot consensusmap(res) # customized plot consensusmap(res, annCol=covariates, annColors=list(c='blue') , labCol='sample ', main='Cluster stability' , sub='Consensus matrix and all covariates') par(opar) @ By default: \begin{itemize} \item the rows and columns of the consensus heatmap are symmetrically ordered by hierarchical clustering using the consensus matrix as a similarity measure and average linkage, and the associated dendrogram is displayed; \item the color palette used is the reverse of \code{'RdYlBu'} from the \citeCRANpkg{RColorBrewer}. \end{itemize} In term of arguments passed to the heatmap engine \code{aheatmap}, these default settings translate as: <>= distfun = function(x) as.dist(1-x) # x being the consensus matrix hclustfun = 'average' Rowv = TRUE Colv = "Rowv" color = '-RdYlBu' @ \subsection{Single method over a range of ranks} The function \code{nmf} accepts a range of value for the rank (argument \code{rank}), making it fit NMF models for each value in the given range \footnote{Before version 0.6, this feature was provided by the function \code{nmfEstimateRank}. From version 0.6, the function \code{nmf} accepts ranges of ranks, and internally calls the function \code{nmfEstimateRank} -- that remains exported and can still be called directly. See documentation \code{?nmfEstimateRank} for more details on the returned value.}: <>= res2_7 <- nmf(X, 2:7, nrun=10, .options='v') class(res2_7) @ The result \code{res2\_7} is an S3 object of class \code{'NMF.rank'}, that contains -- amongst other data -- a list of the best fits obtained for each value of the rank in range $\ldbrack 2, 7\rdbrack]$. The method of \code{consensusmap} defined for class \code{'NMF.rank'}, which plots all the consensus matrices on the same plot: <>= consensusmap(res2_7) @ \nbnote{ The main title of each consensus heatmap can be customized by passing to argument \code{main} a character vector or a list whose elements specify each title. All other arguments are used in each internal call to consensusmap, and will therefore affect all the plots simultaneously. The layout can be specified via argument \code{layout} as a numeric vector giving the number of rows and columns in a \code{mfrow}-like way, or as a matrix that will be passed to R core function \code{layout}. See \code{?consensusmap} for more details and example code. } \subsection{Single rank over a range of methods} If one is interested in comparing methods, for a given factorization rank, then on can fit an NMF model for each method by providing the function \code{nmf} with a \code{list} in argument \code{method}: <>= res_methods <- nmf(X, 3, list('lee', 'brunet', 'nsNMF'), nrun=10) class(res_methods) @ The result \code{res\_methods} is an S4 object of class \code{NMFList}, which is essentially a named list, that contains each fits and the CPU time required by the whole computation. As previously, the sequence of consensus matrices is plotted with \code{consensusmap}: <>= consensusmap(res_methods) @ \section{Generic heatmap engine: \texttt{aheatmap}} \label{sec:aheatmap} This section still needs to be written, but many examples of annotated heatmaps can be found in the demos \code{'aheatmap'} and \code{'heatmaps'}: <>= demo('aheatmap') # or demo('heatmaps') @ These demos and the plots they generate can also be browsed online at \url{http://nmf.r-forge.r-project.org/_DEMOS.html}. \section{Session Info} <>= toLatex(sessionInfo()) @ \printbibliography[heading=bibintoc] \end{document} NMF/vignettes/NMF-unitTests.Rnw0000644000176000001440000002025012305630424016040 0ustar ripleyusers \documentclass[10pt]{article} %\VignetteDepends{knitr} %\VignetteIndexEntry{NMF-unitTests} %\VignetteCompiler{knitr} %\VignetteEngine{knitr::knitr} \usepackage{vmargin} \setmargrb{0.75in}{0.75in}{0.75in}{0.75in} <>= pkg <- 'NMF' require( pkg, character.only=TRUE ) prettyVersion <- packageDescription(pkg)$Version prettyDate <- format(Sys.Date(), '%B %e, %Y') authors <- packageDescription(pkg)$Author @ \usepackage[colorlinks]{hyperref} \author{\Sexpr{authors}} \title{\texttt{\Sexpr{pkg}}: Unit testing results\footnote{Vignette computed on Tue Mar 4 13:14:49 2014}} \date{\texttt{\Sexpr{pkg}} version \Sexpr{prettyVersion} as of \Sexpr{prettyDate}} \begin{document} \maketitle \section{Details} \begin{verbatim} RUNIT TEST PROTOCOL -- Tue Mar 4 13:14:49 2014 *********************************************** Number of test functions: 81 Number of deactivated test functions: 5 Number of errors: 0 Number of failures: 0 1 Test Suite : package:NMF - 81 test functions, 0 errors, 0 failures Details *************************** Test Suite: package:NMF Test function regexp: ^test. Test file regexp: ^runit.*.[rR]$ Involved directory: /tmp/Rpkglib_26ff65706d7b/NMF/tests --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.aheatmap.R test.mfrow: (1 checks) ... OK (0.69 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.algorithms.r test.brunet: (16 checks) ... OK (4.22 seconds) test.cversions.brunet: (1 checks) ... OK (0.87 seconds) test.cversions.lee: (1 checks) ... OK (1.03 seconds) test.cversions.lnmf : DEACTIVATED, Algorithm 'lnmf' is not fully working. test.cversions.ns: (1 checks) ... OK (1.11 seconds) test.cversions.offset: (1 checks) ... OK (2.19 seconds) test.frobenius: (16 checks) ... OK (5.38 seconds) test.KL: (16 checks) ... OK (4.23 seconds) test.lee: (16 checks) ... OK (3.72 seconds) test.lnmf : DEACTIVATED, Algorithm 'lnmf' is not fully working. test.ns: (16 checks) ... OK (3.78 seconds) test.offset: (16 checks) ... OK (3.97 seconds) test.port_brunet : DEACTIVATED, Package RcppOctave not available. test.snmf: (44 checks) ... OK (9.39 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.bioc.r test.access: (26 checks) ... OK (0.02 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.distance.r test.KL: (9 checks) ... OK (1.44 seconds) test.rss: (4 checks) ... OK (0.06 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.interface.r test.compare: (5 checks) ... OK (9.3 seconds) test.nmf.callback: (22 checks) ... OK (13.81 seconds) test.nmf.custom: (87 checks) ... OK (1.5 seconds) test.nmf.default: (8 checks) ... OK (0.23 seconds) test.nmf.dots: (11 checks) ... OK (0.84 seconds) test.nmf.method: (36 checks) ... OK (10.79 seconds) test.nmf.model: (22 checks) ... OK (0.62 seconds) test.nmfModel.formula: (12 checks) ... OK (0.92 seconds) test.nmf.multirank: (10 checks) ... OK (5.68 seconds) test.nmf.options: (18 checks) ... OK (5.44 seconds) test.nmf.parameters: (53 checks) ... OK (0.81 seconds) test.nmf.seed.argument: (149 checks) ... OK (9.4 seconds) test.nmf.seed.equivalent: (11 checks) ... OK (10.82 seconds) test.nmf.seed.fault: (4 checks) ... OK (2.9 seconds) test.nmf.seed.repro: (8 checks) ... OK (14.43 seconds) test.nmf.stop: (6 checks) ... OK (2.17 seconds) test.parallel: (6 checks) ... OK (12.28 seconds) test.registry: (9 checks) ... OK (0.13 seconds) test.seed: (33 checks) ... OK (0.13 seconds) test.summary: (3 checks) ... OK (2.86 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.NMFclass.r test.basis: (2 checks) ... OK (0.01 seconds) test.class.NMFns: (65 checks) ... OK (0.03 seconds) test.class.NMFstd: (28 checks) ... OK (0.01 seconds) test.coef: (2 checks) ... OK (0 seconds) test.connectivity: (3 checks) ... OK (0.01 seconds) test.deviance: (9 checks) ... OK (0.02 seconds) test.dimensions: (4 checks) ... OK (0 seconds) test.dimnames: (173 checks) ... OK (0.08 seconds) test.entropy: (5 checks) ... OK (0 seconds) test.misc: (9 checks) ... OK (0 seconds) test.nmfModel: (363 checks) ... OK (0.11 seconds) test.NMF.rnmf: (93 checks) ... OK (1.5 seconds) test.predict: (10 checks) ... OK (0.01 seconds) test.purity: (5 checks) ... OK (0 seconds) test.sparseness: (13 checks) ... OK (0.01 seconds) test.subset: (50 checks) ... OK (0.05 seconds) test.syntheticNMF: (5 checks) ... OK (1.62 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.NMFfit-class.r test.deviance: (0 checks) ... OK (0 seconds) test.isNMFfit: (6 checks) ... OK (3.59 seconds) test.niter: (4 checks) ... OK (1.1 seconds) test.nmf.equal: (304 checks) ... OK (1.87 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.NMFSet.r test.fit: (9 checks) ... OK (3.85 seconds) test.interface: (6 checks) ... OK (1.86 seconds) test.join.multipleAndSingleRunsMethods: (2 checks) ... OK (3.32 seconds) test.join.multipleRuns: (2 checks) ... OK (4.6 seconds) test.join.singleRuns: (7 checks) ... OK (0.7 seconds) test.multipleruns: (2 checks) ... OK (1.7 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.NMFStrategy-class.r test.accessors: (26 checks) ... OK (0.06 seconds) test.constructor: (16 checks) ... OK (0.06 seconds) test.constructorMethod: (3 checks) ... OK (0.04 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.options.r test.nmf.getOption: (2 checks) ... OK (0 seconds) test.nmf.options: (9 checks) ... OK (0 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.parallel.r test.ForeachBackend: (4 checks) ... OK (1.37 seconds) test.gVariable: (11 checks) ... OK (10.16 seconds) test.nmf: (59 checks) ... OK (41.99 seconds) test.setupBackend: (4 checks) ... OK (0.05 seconds) test.shared_memory_doMC: (12 checks) ... OK (6.1 seconds) test.shared_memory_doMPI : DEACTIVATED, NMF shared memory feature does not currently work with doMPI. test.shared_memory_doParallel: (12 checks) ... OK (10.88 seconds) test.shared_memory_doSEQ: (11 checks) ... OK (6.46 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.seed.r test.nndsvd: (10 checks) ... OK (0.04 seconds) test.none: (6 checks) ... OK (0.03 seconds) test.random: (26 checks) ... OK (0.13 seconds) test.restore : DEACTIVATED, The option 'restore.seed' is deprecated. Related tests are now in test.seed.effect test.seed.effect: (15 checks) ... OK (16.37 seconds) test.zzz.all: (297 checks) ... OK (16.42 seconds) --------------------------- Test file: /tmp/Rpkglib_26ff65706d7b/NMF/tests/runit.utils.r test.nmfWrapper: (16 checks) ... OK (0.85 seconds) test.rmatrix: (16 checks) ... OK (0.01 seconds) Total execution time *************************** user system elapsed 253.753 31.645 293.297 \end{verbatim} \section*{Session Information} \begin{itemize}\raggedright \item R Under development (unstable) (2014-03-02 r65102), \verb|x86_64-unknown-linux-gnu| \item Locale: \verb|LC_CTYPE=en_US.UTF-8|, \verb|LC_NUMERIC=C|, \verb|LC_TIME=en_US.UTF-8|, \verb|LC_COLLATE=en_US.UTF-8|, \verb|LC_MONETARY=en_US.UTF-8|, \verb|LC_MESSAGES=en_US.UTF-8|, \verb|LC_PAPER=en_US.UTF-8|, \verb|LC_NAME=C|, \verb|LC_ADDRESS=C|, \verb|LC_TELEPHONE=C|, \verb|LC_MEASUREMENT=en_US.UTF-8|, \verb|LC_IDENTIFICATION=C| \item Base packages: base, datasets, graphics, grDevices, methods, parallel, stats, utils \item Other packages: BH~1.51.0-4, bigmemory~4.4.6, bigmemory.sri~0.1.2, Biobase~2.22.0, BiocGenerics~0.8.0, cluster~1.14.4, doMPI~0.2, doParallel~1.0.8, fastICA~1.2-0, foreach~1.4.1, iterators~1.0.6, NMF~0.20.2, pkgmaker~0.17.4, RColorBrewer~1.0-5, Rcpp~0.11.0, registry~0.2, Rmpi~0.6-3, rngtools~1.2.3, RUnit~0.4.26, stringr~0.6.2, synchronicity~1.1.2 \item Loaded via a namespace (and not attached): codetools~0.2-8, colorspace~1.2-4, compiler~3.1.0, dichromat~2.0-0, digest~0.6.4, ggplot2~0.9.3.1, grid~3.1.0, gridBase~0.4-7, gtable~0.1.2, labeling~0.2, MASS~7.3-29, munsell~0.4.2, plyr~1.8.1, proto~0.3-10, reshape2~1.2.2, scales~0.2.3, tools~3.1.0, xtable~1.7-1 \end{itemize} \end{document} NMF/vignettes/src/0000755000176000001440000000000012234465004013521 5ustar ripleyusersNMF/vignettes/src/bmc.R0000644000176000001440000000240512234465004014406 0ustar ripleyusers# Scripts runs to produce the figures in the BMC paper # # Author: renaud ############################################################################### # install and load NMF package lib.dir <- 'lib' dir.create(lib.dir, showWarnings=FALSE) install.packages('NMF_0.1.tar.gz', repos=NULL, lib=lib.dir) library(NMF, lib=lib.dir) # define a seed .seed <- 123456 # load Golub data data(esGolub) #esGolub <- syntheticNMF(500, 3, 20, noise=TRUE) # estimate rank for Golub dataset rank.nrun <- 50 rank.range <- seq(2,6) res.estimate <- nmfEstimateRank(esGolub, rank.range, method='brunet' , nrun=rank.nrun, conf.interval=TRUE, seed=.seed) save(res.estimate, file='res.estimate.rda') # Full run of Brunet algorithm nmf.nrun <- 200 res.brunet <- nmf(esGolub, 3, 'brunet', nrun=nmf.nrun, seed=.seed, .options='tv') save(res.brunet, file='res.brunet.rda') # Comparison of methods res.comp <- nmf(esGolub, 3, list('brunet', 'lee', 'ns', 'lnmf'), seed='nndsvd', .options='tv') save(res.comp, file='res.comp.rda') # save all in one file save(res.estimate, res.brunet, res.comp, file='res.bmc.rda') if( FALSE ){ # generate plots png('consensus.png') metaHeatmap(res.brunet, class=esGolub$Cell) dev.off() png('metagenes.png') metaHeatmap(fit(res.brunet), class=esGolub$Cell) dev.off() }NMF/vignettes/consensus.pdf0000644000176000001440000023327612234465004015462 0ustar ripleyusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20111003210125) /ModDate (D:20111003210125) /Title (R Graphics Output) /Producer (R 2.13.1) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 9 0 R >> stream 1 J 1 j q Q q Q q Q q Q q 54.99 425.88 326.74 49.49 re W n /sRGB CS 0.000 0.000 0.000 SCN 0.75 w [] 0 d 1 J 1 j 10.00 M 132.36 475.37 m 67.85 475.37 l S 67.85 475.37 m 67.85 425.88 l S 67.85 425.88 m 59.29 425.88 l S 59.29 425.88 m 59.29 425.88 l S 67.85 425.88 m 76.42 425.88 l S 76.42 425.88 m 76.42 425.88 l S 76.42 425.88 m 67.88 425.88 l S 67.88 425.88 m 67.88 425.88 l S 76.42 425.88 m 84.95 425.88 l S 84.95 425.88 m 84.95 425.88 l S 84.95 425.88 m 76.48 425.88 l S 76.48 425.88 m 76.48 425.88 l S 84.95 425.88 m 93.41 425.88 l S 93.41 425.88 m 93.41 425.88 l S 93.41 425.88 m 85.08 425.88 l S 85.08 425.88 m 85.08 425.88 l S 93.41 425.88 m 101.74 425.88 l S 101.74 425.88 m 101.74 425.88 l S 101.74 425.88 m 93.68 425.88 l S 93.68 425.88 m 93.68 425.88 l S 101.74 425.88 m 109.80 425.88 l S 109.80 425.88 m 109.80 425.88 l S 109.80 425.88 m 102.28 425.88 l S 102.28 425.88 m 102.28 425.88 l S 109.80 425.88 m 117.33 425.88 l S 117.33 425.88 m 117.33 425.88 l S 117.33 425.88 m 110.88 425.88 l S 110.88 425.88 m 110.88 425.88 l S 117.33 425.88 m 123.77 425.88 l S 123.77 425.88 m 123.77 425.88 l S 123.77 425.88 m 119.48 425.88 l S 119.48 425.88 m 119.48 425.88 l S 123.77 425.88 m 128.07 425.88 l S 128.07 425.88 m 128.07 425.88 l S 132.36 475.37 m 196.86 475.37 l S 196.86 475.37 m 196.86 474.08 l S 196.86 474.08 m 145.27 474.08 l S 145.27 474.08 m 145.27 440.73 l S 145.27 440.73 m 136.67 440.73 l S 136.67 440.73 m 136.67 425.88 l S 145.27 440.73 m 153.86 440.73 l S 153.86 440.73 m 153.86 425.88 l S 153.86 425.88 m 145.27 425.88 l S 145.27 425.88 m 145.27 425.88 l S 153.86 425.88 m 162.45 425.88 l S 162.45 425.88 m 162.45 425.88 l S 162.45 425.88 m 153.87 425.88 l S 153.87 425.88 m 153.87 425.88 l S 162.45 425.88 m 171.03 425.88 l S 171.03 425.88 m 171.03 425.88 l S 171.03 425.88 m 162.47 425.88 l S 162.47 425.88 m 162.47 425.88 l S 171.03 425.88 m 179.60 425.88 l S 179.60 425.88 m 179.60 425.88 l S 179.60 425.88 m 171.07 425.88 l S 171.07 425.88 m 171.07 425.88 l S 179.60 425.88 m 188.13 425.88 l S 188.13 425.88 m 188.13 425.88 l S 188.13 425.88 m 179.66 425.88 l S 179.66 425.88 m 179.66 425.88 l S 188.13 425.88 m 196.59 425.88 l S 196.59 425.88 m 196.59 425.88 l S 196.59 425.88 m 188.26 425.88 l S 188.26 425.88 m 188.26 425.88 l S 196.59 425.88 m 204.92 425.88 l S 204.92 425.88 m 204.92 425.88 l S 204.92 425.88 m 196.86 425.88 l S 196.86 425.88 m 196.86 425.88 l S 204.92 425.88 m 212.98 425.88 l S 212.98 425.88 m 212.98 425.88 l S 212.98 425.88 m 205.46 425.88 l S 205.46 425.88 m 205.46 425.88 l S 212.98 425.88 m 220.51 425.88 l S 220.51 425.88 m 220.51 425.88 l S 220.51 425.88 m 214.06 425.88 l S 214.06 425.88 m 214.06 425.88 l S 220.51 425.88 m 226.96 425.88 l S 226.96 425.88 m 226.96 425.88 l S 226.96 425.88 m 222.66 425.88 l S 222.66 425.88 m 222.66 425.88 l S 226.96 425.88 m 231.26 425.88 l S 231.26 425.88 m 231.26 425.88 l S 196.86 474.08 m 248.45 474.08 l S 248.45 474.08 m 248.45 426.87 l S 248.45 426.87 m 239.85 426.87 l S 239.85 426.87 m 239.85 425.88 l S 248.45 426.87 m 257.05 426.87 l S 257.05 426.87 m 257.05 425.88 l S 257.05 425.88 m 248.45 425.88 l S 248.45 425.88 m 248.45 425.88 l S 257.05 425.88 m 265.65 425.88 l S 265.65 425.88 m 265.65 425.88 l S 265.65 425.88 m 257.05 425.88 l S 257.05 425.88 m 257.05 425.88 l S 265.65 425.88 m 274.25 425.88 l S 274.25 425.88 m 274.25 425.88 l S 274.25 425.88 m 265.65 425.88 l S 265.65 425.88 m 265.65 425.88 l S 274.25 425.88 m 282.84 425.88 l S 282.84 425.88 m 282.84 425.88 l S 282.84 425.88 m 274.25 425.88 l S 274.25 425.88 m 274.25 425.88 l S 282.84 425.88 m 291.44 425.88 l S 291.44 425.88 m 291.44 425.88 l S 291.44 425.88 m 282.85 425.88 l S 282.85 425.88 m 282.85 425.88 l S 291.44 425.88 m 300.04 425.88 l S 300.04 425.88 m 300.04 425.88 l S 300.04 425.88 m 291.45 425.88 l S 291.45 425.88 m 291.45 425.88 l S 300.04 425.88 m 308.63 425.88 l S 308.63 425.88 m 308.63 425.88 l S 308.63 425.88 m 300.04 425.88 l S 300.04 425.88 m 300.04 425.88 l S 308.63 425.88 m 317.21 425.88 l S 317.21 425.88 m 317.21 425.88 l S 317.21 425.88 m 308.64 425.88 l S 308.64 425.88 m 308.64 425.88 l S 317.21 425.88 m 325.77 425.88 l S 325.77 425.88 m 325.77 425.88 l S 325.77 425.88 m 317.24 425.88 l S 317.24 425.88 m 317.24 425.88 l S 325.77 425.88 m 334.30 425.88 l S 334.30 425.88 m 334.30 425.88 l S 334.30 425.88 m 325.84 425.88 l S 325.84 425.88 m 325.84 425.88 l S 334.30 425.88 m 342.77 425.88 l S 342.77 425.88 m 342.77 425.88 l S 342.77 425.88 m 334.44 425.88 l S 334.44 425.88 m 334.44 425.88 l S 342.77 425.88 m 351.10 425.88 l S 351.10 425.88 m 351.10 425.88 l S 351.10 425.88 m 343.04 425.88 l S 343.04 425.88 m 343.04 425.88 l S 351.10 425.88 m 359.16 425.88 l S 359.16 425.88 m 359.16 425.88 l S 359.16 425.88 m 351.63 425.88 l S 351.63 425.88 m 351.63 425.88 l S 359.16 425.88 m 366.68 425.88 l S 366.68 425.88 m 366.68 425.88 l S 366.68 425.88 m 360.23 425.88 l S 360.23 425.88 m 360.23 425.88 l S 366.68 425.88 m 373.13 425.88 l S 373.13 425.88 m 373.13 425.88 l S 373.13 425.88 m 368.83 425.88 l S 368.83 425.88 m 368.83 425.88 l S 373.13 425.88 m 377.43 425.88 l S 377.43 425.88 m 377.43 425.88 l S Q q Q q Q q Q q Q q 0.00 19.81 49.49 378.55 re W n /sRGB CS 0.000 0.000 0.000 SCN 0.75 w [] 0 d 1 J 1 j 10.00 M 0.00 308.72 m 0.00 233.99 l S 0.00 233.99 m 1.30 233.99 l S 1.30 233.99 m 1.30 174.22 l S 1.30 174.22 m 48.50 174.22 l S 48.50 174.22 m 48.50 164.26 l S 48.50 164.26 m 49.49 164.26 l S 49.49 164.26 m 49.49 154.29 l S 49.49 154.29 m 49.49 154.29 l S 49.49 154.29 m 49.49 144.33 l S 49.49 144.33 m 49.49 144.33 l S 49.49 144.33 m 49.49 134.37 l S 49.49 134.37 m 49.49 134.37 l S 49.49 134.37 m 49.49 124.41 l S 49.49 124.41 m 49.49 124.41 l S 49.49 124.41 m 49.49 114.46 l S 49.49 114.46 m 49.49 114.46 l S 49.49 114.46 m 49.49 104.50 l S 49.49 104.50 m 49.49 104.50 l S 49.49 104.50 m 49.49 94.56 l S 49.49 94.56 m 49.49 94.56 l S 49.49 94.56 m 49.49 84.64 l S 49.49 84.64 m 49.49 84.64 l S 49.49 84.64 m 49.49 74.75 l S 49.49 74.75 m 49.49 74.75 l S 49.49 74.75 m 49.49 64.95 l S 49.49 64.95 m 49.49 64.95 l S 49.49 64.95 m 49.49 55.30 l S 49.49 55.30 m 49.49 55.30 l S 49.49 55.30 m 49.49 45.96 l S 49.49 45.96 m 49.49 45.96 l S 49.49 45.96 m 49.49 37.24 l S 49.49 37.24 m 49.49 37.24 l S 49.49 37.24 m 49.49 29.77 l S 49.49 29.77 m 49.49 29.77 l S 49.49 29.77 m 49.49 24.79 l S 49.49 24.79 m 49.49 24.79 l S 49.49 29.77 m 49.49 34.75 l S 49.49 34.75 m 49.49 34.75 l S 49.49 37.24 m 49.49 44.71 l S 49.49 44.71 m 49.49 44.71 l S 49.49 45.96 m 49.49 54.67 l S 49.49 54.67 m 49.49 54.67 l S 49.49 55.30 m 49.49 64.64 l S 49.49 64.64 m 49.49 64.64 l S 49.49 64.95 m 49.49 74.60 l S 49.49 74.60 m 49.49 74.60 l S 49.49 74.75 m 49.49 84.56 l S 49.49 84.56 m 49.49 84.56 l S 49.49 84.64 m 49.49 94.52 l S 49.49 94.52 m 49.49 94.52 l S 49.49 94.56 m 49.49 104.48 l S 49.49 104.48 m 49.49 104.48 l S 49.49 104.50 m 49.49 114.45 l S 49.49 114.45 m 49.49 114.45 l S 49.49 114.46 m 49.49 124.41 l S 49.49 124.41 m 49.49 124.41 l S 49.49 124.41 m 49.49 134.37 l S 49.49 134.37 m 49.49 134.37 l S 49.49 134.37 m 49.49 144.33 l S 49.49 144.33 m 49.49 144.33 l S 49.49 144.33 m 49.49 154.29 l S 49.49 154.29 m 49.49 154.29 l S 49.49 154.29 m 49.49 164.26 l S 49.49 164.26 m 49.49 164.26 l S 49.49 164.26 m 49.49 174.22 l S 49.49 174.22 m 49.49 174.22 l S 48.50 174.22 m 48.50 184.18 l S 48.50 184.18 m 49.49 184.18 l S 1.30 233.99 m 1.30 293.77 l S 1.30 293.77 m 34.64 293.77 l S 34.64 293.77 m 34.64 283.81 l S 34.64 283.81 m 49.49 283.81 l S 49.49 283.81 m 49.49 273.86 l S 49.49 273.86 m 49.49 273.86 l S 49.49 273.86 m 49.49 263.91 l S 49.49 263.91 m 49.49 263.91 l S 49.49 263.91 m 49.49 253.99 l S 49.49 253.99 m 49.49 253.99 l S 49.49 253.99 m 49.49 244.11 l S 49.49 244.11 m 49.49 244.11 l S 49.49 244.11 m 49.49 234.30 l S 49.49 234.30 m 49.49 234.30 l S 49.49 234.30 m 49.49 224.65 l S 49.49 224.65 m 49.49 224.65 l S 49.49 224.65 m 49.49 215.31 l S 49.49 215.31 m 49.49 215.31 l S 49.49 215.31 m 49.49 206.59 l S 49.49 206.59 m 49.49 206.59 l S 49.49 206.59 m 49.49 199.12 l S 49.49 199.12 m 49.49 199.12 l S 49.49 199.12 m 49.49 194.14 l S 49.49 194.14 m 49.49 194.14 l S 49.49 199.12 m 49.49 204.10 l S 49.49 204.10 m 49.49 204.10 l S 49.49 206.59 m 49.49 214.07 l S 49.49 214.07 m 49.49 214.07 l S 49.49 215.31 m 49.49 224.03 l S 49.49 224.03 m 49.49 224.03 l S 49.49 224.65 m 49.49 233.99 l S 49.49 233.99 m 49.49 233.99 l S 49.49 234.30 m 49.49 243.95 l S 49.49 243.95 m 49.49 243.95 l S 49.49 244.11 m 49.49 253.91 l S 49.49 253.91 m 49.49 253.91 l S 49.49 253.99 m 49.49 263.88 l S 49.49 263.88 m 49.49 263.88 l S 49.49 263.91 m 49.49 273.84 l S 49.49 273.84 m 49.49 273.84 l S 49.49 273.86 m 49.49 283.80 l S 49.49 283.80 m 49.49 283.80 l S 49.49 283.81 m 49.49 293.76 l S 49.49 293.76 m 49.49 293.76 l S 34.64 293.77 m 34.64 303.72 l S 34.64 303.72 m 49.49 303.72 l S 0.00 308.72 m 0.00 383.46 l S 0.00 383.46 m 49.49 383.46 l S 49.49 383.46 m 49.49 373.53 l S 49.49 373.53 m 49.49 373.53 l S 49.49 373.53 m 49.49 363.65 l S 49.49 363.65 m 49.49 363.65 l S 49.49 363.65 m 49.49 353.84 l S 49.49 353.84 m 49.49 353.84 l S 49.49 353.84 m 49.49 344.19 l S 49.49 344.19 m 49.49 344.19 l S 49.49 344.19 m 49.49 334.85 l S 49.49 334.85 m 49.49 334.85 l S 49.49 334.85 m 49.49 326.14 l S 49.49 326.14 m 49.49 326.14 l S 49.49 326.14 m 49.49 318.67 l S 49.49 318.67 m 49.49 318.67 l S 49.49 318.67 m 49.49 313.68 l S 49.49 313.68 m 49.49 313.68 l S 49.49 318.67 m 49.49 323.65 l S 49.49 323.65 m 49.49 323.65 l S 49.49 326.14 m 49.49 333.61 l S 49.49 333.61 m 49.49 333.61 l S 49.49 334.85 m 49.49 343.57 l S 49.49 343.57 m 49.49 343.57 l S 49.49 344.19 m 49.49 353.53 l S 49.49 353.53 m 49.49 353.53 l S 49.49 353.84 m 49.49 363.49 l S 49.49 363.49 m 49.49 363.49 l S 49.49 363.65 m 49.49 373.46 l S 49.49 373.46 m 49.49 373.46 l S 49.49 373.53 m 49.49 383.42 l S 49.49 383.42 m 49.49 383.42 l S 49.49 383.46 m 49.49 393.38 l S 49.49 393.38 m 49.49 393.38 l S Q q Q q Q q /sRGB cs 0.192 0.212 0.584 scn 55.00 19.79 8.60 9.96 re f 55.00 29.75 8.60 9.96 re f 55.00 39.71 8.60 9.96 re f 55.00 49.67 8.60 9.96 re f 55.00 59.64 8.60 9.96 re f 55.00 69.60 8.60 9.96 re f 55.00 79.56 8.60 9.96 re f 55.00 89.53 8.60 9.96 re f 55.00 99.49 8.60 9.96 re f 55.00 109.45 8.60 9.96 re f 55.00 119.42 8.60 9.96 re f 55.00 129.38 8.60 9.96 re f 55.00 139.34 8.60 9.96 re f 55.00 149.31 8.60 9.96 re f 55.00 159.27 8.60 9.96 re f 55.00 169.23 8.60 9.96 re f 55.00 179.20 8.60 9.96 re f 55.00 189.16 8.60 9.96 re f 55.00 199.12 8.60 9.96 re f 55.00 209.08 8.60 9.96 re f 55.00 219.05 8.60 9.96 re f 55.00 229.01 8.60 9.96 re f 55.00 238.97 8.60 9.96 re f 55.00 248.94 8.60 9.96 re f 55.00 258.90 8.60 9.96 re f 55.00 268.86 8.60 9.96 re f 55.00 278.83 8.60 9.96 re f 55.00 288.79 8.60 9.96 re f 55.00 298.75 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 55.00 308.72 8.60 9.96 re f 55.00 318.68 8.60 9.96 re f 55.00 328.64 8.60 9.96 re f 55.00 338.61 8.60 9.96 re f 55.00 348.57 8.60 9.96 re f 55.00 358.53 8.60 9.96 re f 55.00 368.49 8.60 9.96 re f 55.00 378.46 8.60 9.96 re f 55.00 388.42 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 63.60 19.79 8.60 9.96 re f 63.60 29.75 8.60 9.96 re f 63.60 39.71 8.60 9.96 re f 63.60 49.67 8.60 9.96 re f 63.60 59.64 8.60 9.96 re f 63.60 69.60 8.60 9.96 re f 63.60 79.56 8.60 9.96 re f 63.60 89.53 8.60 9.96 re f 63.60 99.49 8.60 9.96 re f 63.60 109.45 8.60 9.96 re f 63.60 119.42 8.60 9.96 re f 63.60 129.38 8.60 9.96 re f 63.60 139.34 8.60 9.96 re f 63.60 149.31 8.60 9.96 re f 63.60 159.27 8.60 9.96 re f 63.60 169.23 8.60 9.96 re f 63.60 179.20 8.60 9.96 re f 63.60 189.16 8.60 9.96 re f 63.60 199.12 8.60 9.96 re f 63.60 209.08 8.60 9.96 re f 63.60 219.05 8.60 9.96 re f 63.60 229.01 8.60 9.96 re f 63.60 238.97 8.60 9.96 re f 63.60 248.94 8.60 9.96 re f 63.60 258.90 8.60 9.96 re f 63.60 268.86 8.60 9.96 re f 63.60 278.83 8.60 9.96 re f 63.60 288.79 8.60 9.96 re f 63.60 298.75 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 63.60 308.72 8.60 9.96 re f 63.60 318.68 8.60 9.96 re f 63.60 328.64 8.60 9.96 re f 63.60 338.61 8.60 9.96 re f 63.60 348.57 8.60 9.96 re f 63.60 358.53 8.60 9.96 re f 63.60 368.49 8.60 9.96 re f 63.60 378.46 8.60 9.96 re f 63.60 388.42 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 72.20 19.79 8.60 9.96 re f 72.20 29.75 8.60 9.96 re f 72.20 39.71 8.60 9.96 re f 72.20 49.67 8.60 9.96 re f 72.20 59.64 8.60 9.96 re f 72.20 69.60 8.60 9.96 re f 72.20 79.56 8.60 9.96 re f 72.20 89.53 8.60 9.96 re f 72.20 99.49 8.60 9.96 re f 72.20 109.45 8.60 9.96 re f 72.20 119.42 8.60 9.96 re f 72.20 129.38 8.60 9.96 re f 72.20 139.34 8.60 9.96 re f 72.20 149.31 8.60 9.96 re f 72.20 159.27 8.60 9.96 re f 72.20 169.23 8.60 9.96 re f 72.20 179.20 8.60 9.96 re f 72.20 189.16 8.60 9.96 re f 72.20 199.12 8.60 9.96 re f 72.20 209.08 8.60 9.96 re f 72.20 219.05 8.60 9.96 re f 72.20 229.01 8.60 9.96 re f 72.20 238.97 8.60 9.96 re f 72.20 248.94 8.60 9.96 re f 72.20 258.90 8.60 9.96 re f 72.20 268.86 8.60 9.96 re f 72.20 278.83 8.60 9.96 re f 72.20 288.79 8.60 9.96 re f 72.20 298.75 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 72.20 308.72 8.60 9.96 re f 72.20 318.68 8.60 9.96 re f 72.20 328.64 8.60 9.96 re f 72.20 338.61 8.60 9.96 re f 72.20 348.57 8.60 9.96 re f 72.20 358.53 8.60 9.96 re f 72.20 368.49 8.60 9.96 re f 72.20 378.46 8.60 9.96 re f 72.20 388.42 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 80.79 19.79 8.60 9.96 re f 80.79 29.75 8.60 9.96 re f 80.79 39.71 8.60 9.96 re f 80.79 49.67 8.60 9.96 re f 80.79 59.64 8.60 9.96 re f 80.79 69.60 8.60 9.96 re f 80.79 79.56 8.60 9.96 re f 80.79 89.53 8.60 9.96 re f 80.79 99.49 8.60 9.96 re f 80.79 109.45 8.60 9.96 re f 80.79 119.42 8.60 9.96 re f 80.79 129.38 8.60 9.96 re f 80.79 139.34 8.60 9.96 re f 80.79 149.31 8.60 9.96 re f 80.79 159.27 8.60 9.96 re f 80.79 169.23 8.60 9.96 re f 80.79 179.20 8.60 9.96 re f 80.79 189.16 8.60 9.96 re f 80.79 199.12 8.60 9.96 re f 80.79 209.08 8.60 9.96 re f 80.79 219.05 8.60 9.96 re f 80.79 229.01 8.60 9.96 re f 80.79 238.97 8.60 9.96 re f 80.79 248.94 8.60 9.96 re f 80.79 258.90 8.60 9.96 re f 80.79 268.86 8.60 9.96 re f 80.79 278.83 8.60 9.96 re f 80.79 288.79 8.60 9.96 re f 80.79 298.75 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 80.79 308.72 8.60 9.96 re f 80.79 318.68 8.60 9.96 re f 80.79 328.64 8.60 9.96 re f 80.79 338.61 8.60 9.96 re f 80.79 348.57 8.60 9.96 re f 80.79 358.53 8.60 9.96 re f 80.79 368.49 8.60 9.96 re f 80.79 378.46 8.60 9.96 re f 80.79 388.42 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 89.39 19.79 8.60 9.96 re f 89.39 29.75 8.60 9.96 re f 89.39 39.71 8.60 9.96 re f 89.39 49.67 8.60 9.96 re f 89.39 59.64 8.60 9.96 re f 89.39 69.60 8.60 9.96 re f 89.39 79.56 8.60 9.96 re f 89.39 89.53 8.60 9.96 re f 89.39 99.49 8.60 9.96 re f 89.39 109.45 8.60 9.96 re f 89.39 119.42 8.60 9.96 re f 89.39 129.38 8.60 9.96 re f 89.39 139.34 8.60 9.96 re f 89.39 149.31 8.60 9.96 re f 89.39 159.27 8.60 9.96 re f 89.39 169.23 8.60 9.96 re f 89.39 179.20 8.60 9.96 re f 89.39 189.16 8.60 9.96 re f 89.39 199.12 8.60 9.96 re f 89.39 209.08 8.60 9.96 re f 89.39 219.05 8.60 9.96 re f 89.39 229.01 8.60 9.96 re f 89.39 238.97 8.60 9.96 re f 89.39 248.94 8.60 9.96 re f 89.39 258.90 8.60 9.96 re f 89.39 268.86 8.60 9.96 re f 89.39 278.83 8.60 9.96 re f 89.39 288.79 8.60 9.96 re f 89.39 298.75 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 89.39 308.72 8.60 9.96 re f 89.39 318.68 8.60 9.96 re f 89.39 328.64 8.60 9.96 re f 89.39 338.61 8.60 9.96 re f 89.39 348.57 8.60 9.96 re f 89.39 358.53 8.60 9.96 re f 89.39 368.49 8.60 9.96 re f 89.39 378.46 8.60 9.96 re f 89.39 388.42 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 97.99 19.79 8.60 9.96 re f 97.99 29.75 8.60 9.96 re f 97.99 39.71 8.60 9.96 re f 97.99 49.67 8.60 9.96 re f 97.99 59.64 8.60 9.96 re f 97.99 69.60 8.60 9.96 re f 97.99 79.56 8.60 9.96 re f 97.99 89.53 8.60 9.96 re f 97.99 99.49 8.60 9.96 re f 97.99 109.45 8.60 9.96 re f 97.99 119.42 8.60 9.96 re f 97.99 129.38 8.60 9.96 re f 97.99 139.34 8.60 9.96 re f 97.99 149.31 8.60 9.96 re f 97.99 159.27 8.60 9.96 re f 97.99 169.23 8.60 9.96 re f 97.99 179.20 8.60 9.96 re f 97.99 189.16 8.60 9.96 re f 97.99 199.12 8.60 9.96 re f 97.99 209.08 8.60 9.96 re f 97.99 219.05 8.60 9.96 re f 97.99 229.01 8.60 9.96 re f 97.99 238.97 8.60 9.96 re f 97.99 248.94 8.60 9.96 re f 97.99 258.90 8.60 9.96 re f 97.99 268.86 8.60 9.96 re f 97.99 278.83 8.60 9.96 re f 97.99 288.79 8.60 9.96 re f 97.99 298.75 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 97.99 308.72 8.60 9.96 re f 97.99 318.68 8.60 9.96 re f 97.99 328.64 8.60 9.96 re f 97.99 338.61 8.60 9.96 re f 97.99 348.57 8.60 9.96 re f 97.99 358.53 8.60 9.96 re f 97.99 368.49 8.60 9.96 re f 97.99 378.46 8.60 9.96 re f 97.99 388.42 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 106.59 19.79 8.60 9.96 re f 106.59 29.75 8.60 9.96 re f 106.59 39.71 8.60 9.96 re f 106.59 49.67 8.60 9.96 re f 106.59 59.64 8.60 9.96 re f 106.59 69.60 8.60 9.96 re f 106.59 79.56 8.60 9.96 re f 106.59 89.53 8.60 9.96 re f 106.59 99.49 8.60 9.96 re f 106.59 109.45 8.60 9.96 re f 106.59 119.42 8.60 9.96 re f 106.59 129.38 8.60 9.96 re f 106.59 139.34 8.60 9.96 re f 106.59 149.31 8.60 9.96 re f 106.59 159.27 8.60 9.96 re f 106.59 169.23 8.60 9.96 re f 106.59 179.20 8.60 9.96 re f 106.59 189.16 8.60 9.96 re f 106.59 199.12 8.60 9.96 re f 106.59 209.08 8.60 9.96 re f 106.59 219.05 8.60 9.96 re f 106.59 229.01 8.60 9.96 re f 106.59 238.97 8.60 9.96 re f 106.59 248.94 8.60 9.96 re f 106.59 258.90 8.60 9.96 re f 106.59 268.86 8.60 9.96 re f 106.59 278.83 8.60 9.96 re f 106.59 288.79 8.60 9.96 re f 106.59 298.75 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 106.59 308.72 8.60 9.96 re f 106.59 318.68 8.60 9.96 re f 106.59 328.64 8.60 9.96 re f 106.59 338.61 8.60 9.96 re f 106.59 348.57 8.60 9.96 re f 106.59 358.53 8.60 9.96 re f 106.59 368.49 8.60 9.96 re f 106.59 378.46 8.60 9.96 re f 106.59 388.42 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 115.18 19.79 8.60 9.96 re f 115.18 29.75 8.60 9.96 re f 115.18 39.71 8.60 9.96 re f 115.18 49.67 8.60 9.96 re f 115.18 59.64 8.60 9.96 re f 115.18 69.60 8.60 9.96 re f 115.18 79.56 8.60 9.96 re f 115.18 89.53 8.60 9.96 re f 115.18 99.49 8.60 9.96 re f 115.18 109.45 8.60 9.96 re f 115.18 119.42 8.60 9.96 re f 115.18 129.38 8.60 9.96 re f 115.18 139.34 8.60 9.96 re f 115.18 149.31 8.60 9.96 re f 115.18 159.27 8.60 9.96 re f 115.18 169.23 8.60 9.96 re f 115.18 179.20 8.60 9.96 re f 115.18 189.16 8.60 9.96 re f 115.18 199.12 8.60 9.96 re f 115.18 209.08 8.60 9.96 re f 115.18 219.05 8.60 9.96 re f 115.18 229.01 8.60 9.96 re f 115.18 238.97 8.60 9.96 re f 115.18 248.94 8.60 9.96 re f 115.18 258.90 8.60 9.96 re f 115.18 268.86 8.60 9.96 re f 115.18 278.83 8.60 9.96 re f 115.18 288.79 8.60 9.96 re f 115.18 298.75 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 115.18 308.72 8.60 9.96 re f 115.18 318.68 8.60 9.96 re f 115.18 328.64 8.60 9.96 re f 115.18 338.61 8.60 9.96 re f 115.18 348.57 8.60 9.96 re f 115.18 358.53 8.60 9.96 re f 115.18 368.49 8.60 9.96 re f 115.18 378.46 8.60 9.96 re f 115.18 388.42 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 123.78 19.79 8.60 9.96 re f 123.78 29.75 8.60 9.96 re f 123.78 39.71 8.60 9.96 re f 123.78 49.67 8.60 9.96 re f 123.78 59.64 8.60 9.96 re f 123.78 69.60 8.60 9.96 re f 123.78 79.56 8.60 9.96 re f 123.78 89.53 8.60 9.96 re f 123.78 99.49 8.60 9.96 re f 123.78 109.45 8.60 9.96 re f 123.78 119.42 8.60 9.96 re f 123.78 129.38 8.60 9.96 re f 123.78 139.34 8.60 9.96 re f 123.78 149.31 8.60 9.96 re f 123.78 159.27 8.60 9.96 re f 123.78 169.23 8.60 9.96 re f 123.78 179.20 8.60 9.96 re f 123.78 189.16 8.60 9.96 re f 123.78 199.12 8.60 9.96 re f 123.78 209.08 8.60 9.96 re f 123.78 219.05 8.60 9.96 re f 123.78 229.01 8.60 9.96 re f 123.78 238.97 8.60 9.96 re f 123.78 248.94 8.60 9.96 re f 123.78 258.90 8.60 9.96 re f 123.78 268.86 8.60 9.96 re f 123.78 278.83 8.60 9.96 re f 123.78 288.79 8.60 9.96 re f 123.78 298.75 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 123.78 308.72 8.60 9.96 re f 123.78 318.68 8.60 9.96 re f 123.78 328.64 8.60 9.96 re f 123.78 338.61 8.60 9.96 re f 123.78 348.57 8.60 9.96 re f 123.78 358.53 8.60 9.96 re f 123.78 368.49 8.60 9.96 re f 123.78 378.46 8.60 9.96 re f 123.78 388.42 8.60 9.96 re f /sRGB cs 0.667 0.847 0.910 scn 132.38 19.79 8.60 9.96 re f 132.38 29.75 8.60 9.96 re f 132.38 39.71 8.60 9.96 re f 132.38 49.67 8.60 9.96 re f 132.38 59.64 8.60 9.96 re f 132.38 69.60 8.60 9.96 re f 132.38 79.56 8.60 9.96 re f 132.38 89.53 8.60 9.96 re f 132.38 99.49 8.60 9.96 re f 132.38 109.45 8.60 9.96 re f 132.38 119.42 8.60 9.96 re f 132.38 129.38 8.60 9.96 re f 132.38 139.34 8.60 9.96 re f 132.38 149.31 8.60 9.96 re f 132.38 159.27 8.60 9.96 re f 132.38 169.23 8.60 9.96 re f /sRGB cs 0.710 0.871 0.922 scn 132.38 179.20 8.60 9.96 re f /sRGB cs 0.992 0.682 0.380 scn 132.38 189.16 8.60 9.96 re f 132.38 199.12 8.60 9.96 re f 132.38 209.08 8.60 9.96 re f 132.38 219.05 8.60 9.96 re f 132.38 229.01 8.60 9.96 re f 132.38 238.97 8.60 9.96 re f 132.38 248.94 8.60 9.96 re f 132.38 258.90 8.60 9.96 re f 132.38 268.86 8.60 9.96 re f 132.38 278.83 8.60 9.96 re f 132.38 288.79 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 132.38 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 132.38 308.72 8.60 9.96 re f 132.38 318.68 8.60 9.96 re f 132.38 328.64 8.60 9.96 re f 132.38 338.61 8.60 9.96 re f 132.38 348.57 8.60 9.96 re f 132.38 358.53 8.60 9.96 re f 132.38 368.49 8.60 9.96 re f 132.38 378.46 8.60 9.96 re f 132.38 388.42 8.60 9.96 re f 140.98 19.79 8.60 9.96 re f 140.98 29.75 8.60 9.96 re f 140.98 39.71 8.60 9.96 re f 140.98 49.67 8.60 9.96 re f 140.98 59.64 8.60 9.96 re f 140.98 69.60 8.60 9.96 re f 140.98 79.56 8.60 9.96 re f 140.98 89.53 8.60 9.96 re f 140.98 99.49 8.60 9.96 re f 140.98 109.45 8.60 9.96 re f 140.98 119.42 8.60 9.96 re f 140.98 129.38 8.60 9.96 re f 140.98 139.34 8.60 9.96 re f 140.98 149.31 8.60 9.96 re f 140.98 159.27 8.60 9.96 re f 140.98 169.23 8.60 9.96 re f /sRGB cs 0.208 0.259 0.608 scn 140.98 179.20 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 140.98 189.16 8.60 9.96 re f 140.98 199.12 8.60 9.96 re f 140.98 209.08 8.60 9.96 re f 140.98 219.05 8.60 9.96 re f 140.98 229.01 8.60 9.96 re f 140.98 238.97 8.60 9.96 re f 140.98 248.94 8.60 9.96 re f 140.98 258.90 8.60 9.96 re f 140.98 268.86 8.60 9.96 re f 140.98 278.83 8.60 9.96 re f 140.98 288.79 8.60 9.96 re f /sRGB cs 0.992 0.682 0.380 scn 140.98 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 140.98 308.72 8.60 9.96 re f 140.98 318.68 8.60 9.96 re f 140.98 328.64 8.60 9.96 re f 140.98 338.61 8.60 9.96 re f 140.98 348.57 8.60 9.96 re f 140.98 358.53 8.60 9.96 re f 140.98 368.49 8.60 9.96 re f 140.98 378.46 8.60 9.96 re f 140.98 388.42 8.60 9.96 re f 149.57 19.79 8.60 9.96 re f 149.57 29.75 8.60 9.96 re f 149.57 39.71 8.60 9.96 re f 149.57 49.67 8.60 9.96 re f 149.57 59.64 8.60 9.96 re f 149.57 69.60 8.60 9.96 re f 149.57 79.56 8.60 9.96 re f 149.57 89.53 8.60 9.96 re f 149.57 99.49 8.60 9.96 re f 149.57 109.45 8.60 9.96 re f 149.57 119.42 8.60 9.96 re f 149.57 129.38 8.60 9.96 re f 149.57 139.34 8.60 9.96 re f 149.57 149.31 8.60 9.96 re f 149.57 159.27 8.60 9.96 re f 149.57 169.23 8.60 9.96 re f /sRGB cs 0.208 0.259 0.608 scn 149.57 179.20 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 149.57 189.16 8.60 9.96 re f 149.57 199.12 8.60 9.96 re f 149.57 209.08 8.60 9.96 re f 149.57 219.05 8.60 9.96 re f 149.57 229.01 8.60 9.96 re f 149.57 238.97 8.60 9.96 re f 149.57 248.94 8.60 9.96 re f 149.57 258.90 8.60 9.96 re f 149.57 268.86 8.60 9.96 re f 149.57 278.83 8.60 9.96 re f 149.57 288.79 8.60 9.96 re f /sRGB cs 0.992 0.682 0.380 scn 149.57 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 149.57 308.72 8.60 9.96 re f 149.57 318.68 8.60 9.96 re f 149.57 328.64 8.60 9.96 re f 149.57 338.61 8.60 9.96 re f 149.57 348.57 8.60 9.96 re f 149.57 358.53 8.60 9.96 re f 149.57 368.49 8.60 9.96 re f 149.57 378.46 8.60 9.96 re f 149.57 388.42 8.60 9.96 re f 158.17 19.79 8.60 9.96 re f 158.17 29.75 8.60 9.96 re f 158.17 39.71 8.60 9.96 re f 158.17 49.67 8.60 9.96 re f 158.17 59.64 8.60 9.96 re f 158.17 69.60 8.60 9.96 re f 158.17 79.56 8.60 9.96 re f 158.17 89.53 8.60 9.96 re f 158.17 99.49 8.60 9.96 re f 158.17 109.45 8.60 9.96 re f 158.17 119.42 8.60 9.96 re f 158.17 129.38 8.60 9.96 re f 158.17 139.34 8.60 9.96 re f 158.17 149.31 8.60 9.96 re f 158.17 159.27 8.60 9.96 re f 158.17 169.23 8.60 9.96 re f /sRGB cs 0.208 0.259 0.608 scn 158.17 179.20 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 158.17 189.16 8.60 9.96 re f 158.17 199.12 8.60 9.96 re f 158.17 209.08 8.60 9.96 re f 158.17 219.05 8.60 9.96 re f 158.17 229.01 8.60 9.96 re f 158.17 238.97 8.60 9.96 re f 158.17 248.94 8.60 9.96 re f 158.17 258.90 8.60 9.96 re f 158.17 268.86 8.60 9.96 re f 158.17 278.83 8.60 9.96 re f 158.17 288.79 8.60 9.96 re f /sRGB cs 0.992 0.682 0.380 scn 158.17 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 158.17 308.72 8.60 9.96 re f 158.17 318.68 8.60 9.96 re f 158.17 328.64 8.60 9.96 re f 158.17 338.61 8.60 9.96 re f 158.17 348.57 8.60 9.96 re f 158.17 358.53 8.60 9.96 re f 158.17 368.49 8.60 9.96 re f 158.17 378.46 8.60 9.96 re f 158.17 388.42 8.60 9.96 re f 166.77 19.79 8.60 9.96 re f 166.77 29.75 8.60 9.96 re f 166.77 39.71 8.60 9.96 re f 166.77 49.67 8.60 9.96 re f 166.77 59.64 8.60 9.96 re f 166.77 69.60 8.60 9.96 re f 166.77 79.56 8.60 9.96 re f 166.77 89.53 8.60 9.96 re f 166.77 99.49 8.60 9.96 re f 166.77 109.45 8.60 9.96 re f 166.77 119.42 8.60 9.96 re f 166.77 129.38 8.60 9.96 re f 166.77 139.34 8.60 9.96 re f 166.77 149.31 8.60 9.96 re f 166.77 159.27 8.60 9.96 re f 166.77 169.23 8.60 9.96 re f /sRGB cs 0.208 0.259 0.608 scn 166.77 179.20 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 166.77 189.16 8.60 9.96 re f 166.77 199.12 8.60 9.96 re f 166.77 209.08 8.60 9.96 re f 166.77 219.05 8.60 9.96 re f 166.77 229.01 8.60 9.96 re f 166.77 238.97 8.60 9.96 re f 166.77 248.94 8.60 9.96 re f 166.77 258.90 8.60 9.96 re f 166.77 268.86 8.60 9.96 re f 166.77 278.83 8.60 9.96 re f 166.77 288.79 8.60 9.96 re f /sRGB cs 0.992 0.682 0.380 scn 166.77 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 166.77 308.72 8.60 9.96 re f 166.77 318.68 8.60 9.96 re f 166.77 328.64 8.60 9.96 re f 166.77 338.61 8.60 9.96 re f 166.77 348.57 8.60 9.96 re f 166.77 358.53 8.60 9.96 re f 166.77 368.49 8.60 9.96 re f 166.77 378.46 8.60 9.96 re f 166.77 388.42 8.60 9.96 re f 175.37 19.79 8.60 9.96 re f 175.37 29.75 8.60 9.96 re f 175.37 39.71 8.60 9.96 re f 175.37 49.67 8.60 9.96 re f 175.37 59.64 8.60 9.96 re f 175.37 69.60 8.60 9.96 re f 175.37 79.56 8.60 9.96 re f 175.37 89.53 8.60 9.96 re f 175.37 99.49 8.60 9.96 re f 175.37 109.45 8.60 9.96 re f 175.37 119.42 8.60 9.96 re f 175.37 129.38 8.60 9.96 re f 175.37 139.34 8.60 9.96 re f 175.37 149.31 8.60 9.96 re f 175.37 159.27 8.60 9.96 re f 175.37 169.23 8.60 9.96 re f /sRGB cs 0.208 0.259 0.608 scn 175.37 179.20 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 175.37 189.16 8.60 9.96 re f 175.37 199.12 8.60 9.96 re f 175.37 209.08 8.60 9.96 re f 175.37 219.05 8.60 9.96 re f 175.37 229.01 8.60 9.96 re f 175.37 238.97 8.60 9.96 re f 175.37 248.94 8.60 9.96 re f 175.37 258.90 8.60 9.96 re f 175.37 268.86 8.60 9.96 re f 175.37 278.83 8.60 9.96 re f 175.37 288.79 8.60 9.96 re f /sRGB cs 0.992 0.682 0.380 scn 175.37 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 175.37 308.72 8.60 9.96 re f 175.37 318.68 8.60 9.96 re f 175.37 328.64 8.60 9.96 re f 175.37 338.61 8.60 9.96 re f 175.37 348.57 8.60 9.96 re f 175.37 358.53 8.60 9.96 re f 175.37 368.49 8.60 9.96 re f 175.37 378.46 8.60 9.96 re f 175.37 388.42 8.60 9.96 re f 183.96 19.79 8.60 9.96 re f 183.96 29.75 8.60 9.96 re f 183.96 39.71 8.60 9.96 re f 183.96 49.67 8.60 9.96 re f 183.96 59.64 8.60 9.96 re f 183.96 69.60 8.60 9.96 re f 183.96 79.56 8.60 9.96 re f 183.96 89.53 8.60 9.96 re f 183.96 99.49 8.60 9.96 re f 183.96 109.45 8.60 9.96 re f 183.96 119.42 8.60 9.96 re f 183.96 129.38 8.60 9.96 re f 183.96 139.34 8.60 9.96 re f 183.96 149.31 8.60 9.96 re f 183.96 159.27 8.60 9.96 re f 183.96 169.23 8.60 9.96 re f /sRGB cs 0.208 0.259 0.608 scn 183.96 179.20 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 183.96 189.16 8.60 9.96 re f 183.96 199.12 8.60 9.96 re f 183.96 209.08 8.60 9.96 re f 183.96 219.05 8.60 9.96 re f 183.96 229.01 8.60 9.96 re f 183.96 238.97 8.60 9.96 re f 183.96 248.94 8.60 9.96 re f 183.96 258.90 8.60 9.96 re f 183.96 268.86 8.60 9.96 re f 183.96 278.83 8.60 9.96 re f 183.96 288.79 8.60 9.96 re f /sRGB cs 0.992 0.682 0.380 scn 183.96 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 183.96 308.72 8.60 9.96 re f 183.96 318.68 8.60 9.96 re f 183.96 328.64 8.60 9.96 re f 183.96 338.61 8.60 9.96 re f 183.96 348.57 8.60 9.96 re f 183.96 358.53 8.60 9.96 re f 183.96 368.49 8.60 9.96 re f 183.96 378.46 8.60 9.96 re f 183.96 388.42 8.60 9.96 re f 192.56 19.79 8.60 9.96 re f 192.56 29.75 8.60 9.96 re f 192.56 39.71 8.60 9.96 re f 192.56 49.67 8.60 9.96 re f 192.56 59.64 8.60 9.96 re f 192.56 69.60 8.60 9.96 re f 192.56 79.56 8.60 9.96 re f 192.56 89.53 8.60 9.96 re f 192.56 99.49 8.60 9.96 re f 192.56 109.45 8.60 9.96 re f 192.56 119.42 8.60 9.96 re f 192.56 129.38 8.60 9.96 re f 192.56 139.34 8.60 9.96 re f 192.56 149.31 8.60 9.96 re f 192.56 159.27 8.60 9.96 re f 192.56 169.23 8.60 9.96 re f /sRGB cs 0.208 0.259 0.608 scn 192.56 179.20 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 192.56 189.16 8.60 9.96 re f 192.56 199.12 8.60 9.96 re f 192.56 209.08 8.60 9.96 re f 192.56 219.05 8.60 9.96 re f 192.56 229.01 8.60 9.96 re f 192.56 238.97 8.60 9.96 re f 192.56 248.94 8.60 9.96 re f 192.56 258.90 8.60 9.96 re f 192.56 268.86 8.60 9.96 re f 192.56 278.83 8.60 9.96 re f 192.56 288.79 8.60 9.96 re f /sRGB cs 0.992 0.682 0.380 scn 192.56 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 192.56 308.72 8.60 9.96 re f 192.56 318.68 8.60 9.96 re f 192.56 328.64 8.60 9.96 re f 192.56 338.61 8.60 9.96 re f 192.56 348.57 8.60 9.96 re f 192.56 358.53 8.60 9.96 re f 192.56 368.49 8.60 9.96 re f 192.56 378.46 8.60 9.96 re f 192.56 388.42 8.60 9.96 re f 201.16 19.79 8.60 9.96 re f 201.16 29.75 8.60 9.96 re f 201.16 39.71 8.60 9.96 re f 201.16 49.67 8.60 9.96 re f 201.16 59.64 8.60 9.96 re f 201.16 69.60 8.60 9.96 re f 201.16 79.56 8.60 9.96 re f 201.16 89.53 8.60 9.96 re f 201.16 99.49 8.60 9.96 re f 201.16 109.45 8.60 9.96 re f 201.16 119.42 8.60 9.96 re f 201.16 129.38 8.60 9.96 re f 201.16 139.34 8.60 9.96 re f 201.16 149.31 8.60 9.96 re f 201.16 159.27 8.60 9.96 re f 201.16 169.23 8.60 9.96 re f /sRGB cs 0.208 0.259 0.608 scn 201.16 179.20 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 201.16 189.16 8.60 9.96 re f 201.16 199.12 8.60 9.96 re f 201.16 209.08 8.60 9.96 re f 201.16 219.05 8.60 9.96 re f 201.16 229.01 8.60 9.96 re f 201.16 238.97 8.60 9.96 re f 201.16 248.94 8.60 9.96 re f 201.16 258.90 8.60 9.96 re f 201.16 268.86 8.60 9.96 re f 201.16 278.83 8.60 9.96 re f 201.16 288.79 8.60 9.96 re f /sRGB cs 0.992 0.682 0.380 scn 201.16 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 201.16 308.72 8.60 9.96 re f 201.16 318.68 8.60 9.96 re f 201.16 328.64 8.60 9.96 re f 201.16 338.61 8.60 9.96 re f 201.16 348.57 8.60 9.96 re f 201.16 358.53 8.60 9.96 re f 201.16 368.49 8.60 9.96 re f 201.16 378.46 8.60 9.96 re f 201.16 388.42 8.60 9.96 re f 209.76 19.79 8.60 9.96 re f 209.76 29.75 8.60 9.96 re f 209.76 39.71 8.60 9.96 re f 209.76 49.67 8.60 9.96 re f 209.76 59.64 8.60 9.96 re f 209.76 69.60 8.60 9.96 re f 209.76 79.56 8.60 9.96 re f 209.76 89.53 8.60 9.96 re f 209.76 99.49 8.60 9.96 re f 209.76 109.45 8.60 9.96 re f 209.76 119.42 8.60 9.96 re f 209.76 129.38 8.60 9.96 re f 209.76 139.34 8.60 9.96 re f 209.76 149.31 8.60 9.96 re f 209.76 159.27 8.60 9.96 re f 209.76 169.23 8.60 9.96 re f /sRGB cs 0.208 0.259 0.608 scn 209.76 179.20 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 209.76 189.16 8.60 9.96 re f 209.76 199.12 8.60 9.96 re f 209.76 209.08 8.60 9.96 re f 209.76 219.05 8.60 9.96 re f 209.76 229.01 8.60 9.96 re f 209.76 238.97 8.60 9.96 re f 209.76 248.94 8.60 9.96 re f 209.76 258.90 8.60 9.96 re f 209.76 268.86 8.60 9.96 re f 209.76 278.83 8.60 9.96 re f 209.76 288.79 8.60 9.96 re f /sRGB cs 0.992 0.682 0.380 scn 209.76 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 209.76 308.72 8.60 9.96 re f 209.76 318.68 8.60 9.96 re f 209.76 328.64 8.60 9.96 re f 209.76 338.61 8.60 9.96 re f 209.76 348.57 8.60 9.96 re f 209.76 358.53 8.60 9.96 re f 209.76 368.49 8.60 9.96 re f 209.76 378.46 8.60 9.96 re f 209.76 388.42 8.60 9.96 re f 218.35 19.79 8.60 9.96 re f 218.35 29.75 8.60 9.96 re f 218.35 39.71 8.60 9.96 re f 218.35 49.67 8.60 9.96 re f 218.35 59.64 8.60 9.96 re f 218.35 69.60 8.60 9.96 re f 218.35 79.56 8.60 9.96 re f 218.35 89.53 8.60 9.96 re f 218.35 99.49 8.60 9.96 re f 218.35 109.45 8.60 9.96 re f 218.35 119.42 8.60 9.96 re f 218.35 129.38 8.60 9.96 re f 218.35 139.34 8.60 9.96 re f 218.35 149.31 8.60 9.96 re f 218.35 159.27 8.60 9.96 re f 218.35 169.23 8.60 9.96 re f /sRGB cs 0.208 0.259 0.608 scn 218.35 179.20 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 218.35 189.16 8.60 9.96 re f 218.35 199.12 8.60 9.96 re f 218.35 209.08 8.60 9.96 re f 218.35 219.05 8.60 9.96 re f 218.35 229.01 8.60 9.96 re f 218.35 238.97 8.60 9.96 re f 218.35 248.94 8.60 9.96 re f 218.35 258.90 8.60 9.96 re f 218.35 268.86 8.60 9.96 re f 218.35 278.83 8.60 9.96 re f 218.35 288.79 8.60 9.96 re f /sRGB cs 0.992 0.682 0.380 scn 218.35 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 218.35 308.72 8.60 9.96 re f 218.35 318.68 8.60 9.96 re f 218.35 328.64 8.60 9.96 re f 218.35 338.61 8.60 9.96 re f 218.35 348.57 8.60 9.96 re f 218.35 358.53 8.60 9.96 re f 218.35 368.49 8.60 9.96 re f 218.35 378.46 8.60 9.96 re f 218.35 388.42 8.60 9.96 re f 226.95 19.79 8.60 9.96 re f 226.95 29.75 8.60 9.96 re f 226.95 39.71 8.60 9.96 re f 226.95 49.67 8.60 9.96 re f 226.95 59.64 8.60 9.96 re f 226.95 69.60 8.60 9.96 re f 226.95 79.56 8.60 9.96 re f 226.95 89.53 8.60 9.96 re f 226.95 99.49 8.60 9.96 re f 226.95 109.45 8.60 9.96 re f 226.95 119.42 8.60 9.96 re f 226.95 129.38 8.60 9.96 re f 226.95 139.34 8.60 9.96 re f 226.95 149.31 8.60 9.96 re f 226.95 159.27 8.60 9.96 re f 226.95 169.23 8.60 9.96 re f /sRGB cs 0.208 0.259 0.608 scn 226.95 179.20 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 226.95 189.16 8.60 9.96 re f 226.95 199.12 8.60 9.96 re f 226.95 209.08 8.60 9.96 re f 226.95 219.05 8.60 9.96 re f 226.95 229.01 8.60 9.96 re f 226.95 238.97 8.60 9.96 re f 226.95 248.94 8.60 9.96 re f 226.95 258.90 8.60 9.96 re f 226.95 268.86 8.60 9.96 re f 226.95 278.83 8.60 9.96 re f 226.95 288.79 8.60 9.96 re f /sRGB cs 0.992 0.682 0.380 scn 226.95 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 226.95 308.72 8.60 9.96 re f 226.95 318.68 8.60 9.96 re f 226.95 328.64 8.60 9.96 re f 226.95 338.61 8.60 9.96 re f 226.95 348.57 8.60 9.96 re f 226.95 358.53 8.60 9.96 re f 226.95 368.49 8.60 9.96 re f 226.95 378.46 8.60 9.96 re f 226.95 388.42 8.60 9.96 re f /sRGB cs 0.686 0.035 0.149 scn 235.55 19.79 8.60 9.96 re f 235.55 29.75 8.60 9.96 re f 235.55 39.71 8.60 9.96 re f 235.55 49.67 8.60 9.96 re f 235.55 59.64 8.60 9.96 re f 235.55 69.60 8.60 9.96 re f 235.55 79.56 8.60 9.96 re f 235.55 89.53 8.60 9.96 re f 235.55 99.49 8.60 9.96 re f 235.55 109.45 8.60 9.96 re f 235.55 119.42 8.60 9.96 re f 235.55 129.38 8.60 9.96 re f 235.55 139.34 8.60 9.96 re f 235.55 149.31 8.60 9.96 re f 235.55 159.27 8.60 9.96 re f 235.55 169.23 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 235.55 179.20 8.60 9.96 re f /sRGB cs 0.208 0.259 0.608 scn 235.55 189.16 8.60 9.96 re f 235.55 199.12 8.60 9.96 re f 235.55 209.08 8.60 9.96 re f 235.55 219.05 8.60 9.96 re f 235.55 229.01 8.60 9.96 re f 235.55 238.97 8.60 9.96 re f 235.55 248.94 8.60 9.96 re f 235.55 258.90 8.60 9.96 re f 235.55 268.86 8.60 9.96 re f 235.55 278.83 8.60 9.96 re f 235.55 288.79 8.60 9.96 re f /sRGB cs 0.710 0.871 0.922 scn 235.55 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 235.55 308.72 8.60 9.96 re f 235.55 318.68 8.60 9.96 re f 235.55 328.64 8.60 9.96 re f 235.55 338.61 8.60 9.96 re f 235.55 348.57 8.60 9.96 re f 235.55 358.53 8.60 9.96 re f 235.55 368.49 8.60 9.96 re f 235.55 378.46 8.60 9.96 re f 235.55 388.42 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 244.15 19.79 8.60 9.96 re f 244.15 29.75 8.60 9.96 re f 244.15 39.71 8.60 9.96 re f 244.15 49.67 8.60 9.96 re f 244.15 59.64 8.60 9.96 re f 244.15 69.60 8.60 9.96 re f 244.15 79.56 8.60 9.96 re f 244.15 89.53 8.60 9.96 re f 244.15 99.49 8.60 9.96 re f 244.15 109.45 8.60 9.96 re f 244.15 119.42 8.60 9.96 re f 244.15 129.38 8.60 9.96 re f 244.15 139.34 8.60 9.96 re f 244.15 149.31 8.60 9.96 re f 244.15 159.27 8.60 9.96 re f 244.15 169.23 8.60 9.96 re f /sRGB cs 0.686 0.035 0.149 scn 244.15 179.20 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 244.15 189.16 8.60 9.96 re f 244.15 199.12 8.60 9.96 re f 244.15 209.08 8.60 9.96 re f 244.15 219.05 8.60 9.96 re f 244.15 229.01 8.60 9.96 re f 244.15 238.97 8.60 9.96 re f 244.15 248.94 8.60 9.96 re f 244.15 258.90 8.60 9.96 re f 244.15 268.86 8.60 9.96 re f 244.15 278.83 8.60 9.96 re f 244.15 288.79 8.60 9.96 re f /sRGB cs 0.667 0.847 0.910 scn 244.15 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 244.15 308.72 8.60 9.96 re f 244.15 318.68 8.60 9.96 re f 244.15 328.64 8.60 9.96 re f 244.15 338.61 8.60 9.96 re f 244.15 348.57 8.60 9.96 re f 244.15 358.53 8.60 9.96 re f 244.15 368.49 8.60 9.96 re f 244.15 378.46 8.60 9.96 re f 244.15 388.42 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 252.75 19.79 8.60 9.96 re f 252.75 29.75 8.60 9.96 re f 252.75 39.71 8.60 9.96 re f 252.75 49.67 8.60 9.96 re f 252.75 59.64 8.60 9.96 re f 252.75 69.60 8.60 9.96 re f 252.75 79.56 8.60 9.96 re f 252.75 89.53 8.60 9.96 re f 252.75 99.49 8.60 9.96 re f 252.75 109.45 8.60 9.96 re f 252.75 119.42 8.60 9.96 re f 252.75 129.38 8.60 9.96 re f 252.75 139.34 8.60 9.96 re f 252.75 149.31 8.60 9.96 re f 252.75 159.27 8.60 9.96 re f 252.75 169.23 8.60 9.96 re f /sRGB cs 0.686 0.035 0.149 scn 252.75 179.20 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 252.75 189.16 8.60 9.96 re f 252.75 199.12 8.60 9.96 re f 252.75 209.08 8.60 9.96 re f 252.75 219.05 8.60 9.96 re f 252.75 229.01 8.60 9.96 re f 252.75 238.97 8.60 9.96 re f 252.75 248.94 8.60 9.96 re f 252.75 258.90 8.60 9.96 re f 252.75 268.86 8.60 9.96 re f 252.75 278.83 8.60 9.96 re f 252.75 288.79 8.60 9.96 re f /sRGB cs 0.667 0.847 0.910 scn 252.75 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 252.75 308.72 8.60 9.96 re f 252.75 318.68 8.60 9.96 re f 252.75 328.64 8.60 9.96 re f 252.75 338.61 8.60 9.96 re f 252.75 348.57 8.60 9.96 re f 252.75 358.53 8.60 9.96 re f 252.75 368.49 8.60 9.96 re f 252.75 378.46 8.60 9.96 re f 252.75 388.42 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 261.34 19.79 8.60 9.96 re f 261.34 29.75 8.60 9.96 re f 261.34 39.71 8.60 9.96 re f 261.34 49.67 8.60 9.96 re f 261.34 59.64 8.60 9.96 re f 261.34 69.60 8.60 9.96 re f 261.34 79.56 8.60 9.96 re f 261.34 89.53 8.60 9.96 re f 261.34 99.49 8.60 9.96 re f 261.34 109.45 8.60 9.96 re f 261.34 119.42 8.60 9.96 re f 261.34 129.38 8.60 9.96 re f 261.34 139.34 8.60 9.96 re f 261.34 149.31 8.60 9.96 re f 261.34 159.27 8.60 9.96 re f 261.34 169.23 8.60 9.96 re f /sRGB cs 0.686 0.035 0.149 scn 261.34 179.20 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 261.34 189.16 8.60 9.96 re f 261.34 199.12 8.60 9.96 re f 261.34 209.08 8.60 9.96 re f 261.34 219.05 8.60 9.96 re f 261.34 229.01 8.60 9.96 re f 261.34 238.97 8.60 9.96 re f 261.34 248.94 8.60 9.96 re f 261.34 258.90 8.60 9.96 re f 261.34 268.86 8.60 9.96 re f 261.34 278.83 8.60 9.96 re f 261.34 288.79 8.60 9.96 re f /sRGB cs 0.667 0.847 0.910 scn 261.34 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 261.34 308.72 8.60 9.96 re f 261.34 318.68 8.60 9.96 re f 261.34 328.64 8.60 9.96 re f 261.34 338.61 8.60 9.96 re f 261.34 348.57 8.60 9.96 re f 261.34 358.53 8.60 9.96 re f 261.34 368.49 8.60 9.96 re f 261.34 378.46 8.60 9.96 re f 261.34 388.42 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 269.94 19.79 8.60 9.96 re f 269.94 29.75 8.60 9.96 re f 269.94 39.71 8.60 9.96 re f 269.94 49.67 8.60 9.96 re f 269.94 59.64 8.60 9.96 re f 269.94 69.60 8.60 9.96 re f 269.94 79.56 8.60 9.96 re f 269.94 89.53 8.60 9.96 re f 269.94 99.49 8.60 9.96 re f 269.94 109.45 8.60 9.96 re f 269.94 119.42 8.60 9.96 re f 269.94 129.38 8.60 9.96 re f 269.94 139.34 8.60 9.96 re f 269.94 149.31 8.60 9.96 re f 269.94 159.27 8.60 9.96 re f 269.94 169.23 8.60 9.96 re f /sRGB cs 0.686 0.035 0.149 scn 269.94 179.20 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 269.94 189.16 8.60 9.96 re f 269.94 199.12 8.60 9.96 re f 269.94 209.08 8.60 9.96 re f 269.94 219.05 8.60 9.96 re f 269.94 229.01 8.60 9.96 re f 269.94 238.97 8.60 9.96 re f 269.94 248.94 8.60 9.96 re f 269.94 258.90 8.60 9.96 re f 269.94 268.86 8.60 9.96 re f 269.94 278.83 8.60 9.96 re f 269.94 288.79 8.60 9.96 re f /sRGB cs 0.667 0.847 0.910 scn 269.94 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 269.94 308.72 8.60 9.96 re f 269.94 318.68 8.60 9.96 re f 269.94 328.64 8.60 9.96 re f 269.94 338.61 8.60 9.96 re f 269.94 348.57 8.60 9.96 re f 269.94 358.53 8.60 9.96 re f 269.94 368.49 8.60 9.96 re f 269.94 378.46 8.60 9.96 re f 269.94 388.42 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 278.54 19.79 8.60 9.96 re f 278.54 29.75 8.60 9.96 re f 278.54 39.71 8.60 9.96 re f 278.54 49.67 8.60 9.96 re f 278.54 59.64 8.60 9.96 re f 278.54 69.60 8.60 9.96 re f 278.54 79.56 8.60 9.96 re f 278.54 89.53 8.60 9.96 re f 278.54 99.49 8.60 9.96 re f 278.54 109.45 8.60 9.96 re f 278.54 119.42 8.60 9.96 re f 278.54 129.38 8.60 9.96 re f 278.54 139.34 8.60 9.96 re f 278.54 149.31 8.60 9.96 re f 278.54 159.27 8.60 9.96 re f 278.54 169.23 8.60 9.96 re f /sRGB cs 0.686 0.035 0.149 scn 278.54 179.20 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 278.54 189.16 8.60 9.96 re f 278.54 199.12 8.60 9.96 re f 278.54 209.08 8.60 9.96 re f 278.54 219.05 8.60 9.96 re f 278.54 229.01 8.60 9.96 re f 278.54 238.97 8.60 9.96 re f 278.54 248.94 8.60 9.96 re f 278.54 258.90 8.60 9.96 re f 278.54 268.86 8.60 9.96 re f 278.54 278.83 8.60 9.96 re f 278.54 288.79 8.60 9.96 re f /sRGB cs 0.667 0.847 0.910 scn 278.54 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 278.54 308.72 8.60 9.96 re f 278.54 318.68 8.60 9.96 re f 278.54 328.64 8.60 9.96 re f 278.54 338.61 8.60 9.96 re f 278.54 348.57 8.60 9.96 re f 278.54 358.53 8.60 9.96 re f 278.54 368.49 8.60 9.96 re f 278.54 378.46 8.60 9.96 re f 278.54 388.42 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 287.14 19.79 8.60 9.96 re f 287.14 29.75 8.60 9.96 re f 287.14 39.71 8.60 9.96 re f 287.14 49.67 8.60 9.96 re f 287.14 59.64 8.60 9.96 re f 287.14 69.60 8.60 9.96 re f 287.14 79.56 8.60 9.96 re f 287.14 89.53 8.60 9.96 re f 287.14 99.49 8.60 9.96 re f 287.14 109.45 8.60 9.96 re f 287.14 119.42 8.60 9.96 re f 287.14 129.38 8.60 9.96 re f 287.14 139.34 8.60 9.96 re f 287.14 149.31 8.60 9.96 re f 287.14 159.27 8.60 9.96 re f 287.14 169.23 8.60 9.96 re f /sRGB cs 0.686 0.035 0.149 scn 287.14 179.20 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 287.14 189.16 8.60 9.96 re f 287.14 199.12 8.60 9.96 re f 287.14 209.08 8.60 9.96 re f 287.14 219.05 8.60 9.96 re f 287.14 229.01 8.60 9.96 re f 287.14 238.97 8.60 9.96 re f 287.14 248.94 8.60 9.96 re f 287.14 258.90 8.60 9.96 re f 287.14 268.86 8.60 9.96 re f 287.14 278.83 8.60 9.96 re f 287.14 288.79 8.60 9.96 re f /sRGB cs 0.667 0.847 0.910 scn 287.14 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 287.14 308.72 8.60 9.96 re f 287.14 318.68 8.60 9.96 re f 287.14 328.64 8.60 9.96 re f 287.14 338.61 8.60 9.96 re f 287.14 348.57 8.60 9.96 re f 287.14 358.53 8.60 9.96 re f 287.14 368.49 8.60 9.96 re f 287.14 378.46 8.60 9.96 re f 287.14 388.42 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 295.73 19.79 8.60 9.96 re f 295.73 29.75 8.60 9.96 re f 295.73 39.71 8.60 9.96 re f 295.73 49.67 8.60 9.96 re f 295.73 59.64 8.60 9.96 re f 295.73 69.60 8.60 9.96 re f 295.73 79.56 8.60 9.96 re f 295.73 89.53 8.60 9.96 re f 295.73 99.49 8.60 9.96 re f 295.73 109.45 8.60 9.96 re f 295.73 119.42 8.60 9.96 re f 295.73 129.38 8.60 9.96 re f 295.73 139.34 8.60 9.96 re f 295.73 149.31 8.60 9.96 re f 295.73 159.27 8.60 9.96 re f 295.73 169.23 8.60 9.96 re f /sRGB cs 0.686 0.035 0.149 scn 295.73 179.20 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 295.73 189.16 8.60 9.96 re f 295.73 199.12 8.60 9.96 re f 295.73 209.08 8.60 9.96 re f 295.73 219.05 8.60 9.96 re f 295.73 229.01 8.60 9.96 re f 295.73 238.97 8.60 9.96 re f 295.73 248.94 8.60 9.96 re f 295.73 258.90 8.60 9.96 re f 295.73 268.86 8.60 9.96 re f 295.73 278.83 8.60 9.96 re f 295.73 288.79 8.60 9.96 re f /sRGB cs 0.667 0.847 0.910 scn 295.73 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 295.73 308.72 8.60 9.96 re f 295.73 318.68 8.60 9.96 re f 295.73 328.64 8.60 9.96 re f 295.73 338.61 8.60 9.96 re f 295.73 348.57 8.60 9.96 re f 295.73 358.53 8.60 9.96 re f 295.73 368.49 8.60 9.96 re f 295.73 378.46 8.60 9.96 re f 295.73 388.42 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 304.33 19.79 8.60 9.96 re f 304.33 29.75 8.60 9.96 re f 304.33 39.71 8.60 9.96 re f 304.33 49.67 8.60 9.96 re f 304.33 59.64 8.60 9.96 re f 304.33 69.60 8.60 9.96 re f 304.33 79.56 8.60 9.96 re f 304.33 89.53 8.60 9.96 re f 304.33 99.49 8.60 9.96 re f 304.33 109.45 8.60 9.96 re f 304.33 119.42 8.60 9.96 re f 304.33 129.38 8.60 9.96 re f 304.33 139.34 8.60 9.96 re f 304.33 149.31 8.60 9.96 re f 304.33 159.27 8.60 9.96 re f 304.33 169.23 8.60 9.96 re f /sRGB cs 0.686 0.035 0.149 scn 304.33 179.20 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 304.33 189.16 8.60 9.96 re f 304.33 199.12 8.60 9.96 re f 304.33 209.08 8.60 9.96 re f 304.33 219.05 8.60 9.96 re f 304.33 229.01 8.60 9.96 re f 304.33 238.97 8.60 9.96 re f 304.33 248.94 8.60 9.96 re f 304.33 258.90 8.60 9.96 re f 304.33 268.86 8.60 9.96 re f 304.33 278.83 8.60 9.96 re f 304.33 288.79 8.60 9.96 re f /sRGB cs 0.667 0.847 0.910 scn 304.33 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 304.33 308.72 8.60 9.96 re f 304.33 318.68 8.60 9.96 re f 304.33 328.64 8.60 9.96 re f 304.33 338.61 8.60 9.96 re f 304.33 348.57 8.60 9.96 re f 304.33 358.53 8.60 9.96 re f 304.33 368.49 8.60 9.96 re f 304.33 378.46 8.60 9.96 re f 304.33 388.42 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 312.93 19.79 8.60 9.96 re f 312.93 29.75 8.60 9.96 re f 312.93 39.71 8.60 9.96 re f 312.93 49.67 8.60 9.96 re f 312.93 59.64 8.60 9.96 re f 312.93 69.60 8.60 9.96 re f 312.93 79.56 8.60 9.96 re f 312.93 89.53 8.60 9.96 re f 312.93 99.49 8.60 9.96 re f 312.93 109.45 8.60 9.96 re f 312.93 119.42 8.60 9.96 re f 312.93 129.38 8.60 9.96 re f 312.93 139.34 8.60 9.96 re f 312.93 149.31 8.60 9.96 re f 312.93 159.27 8.60 9.96 re f 312.93 169.23 8.60 9.96 re f /sRGB cs 0.686 0.035 0.149 scn 312.93 179.20 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 312.93 189.16 8.60 9.96 re f 312.93 199.12 8.60 9.96 re f 312.93 209.08 8.60 9.96 re f 312.93 219.05 8.60 9.96 re f 312.93 229.01 8.60 9.96 re f 312.93 238.97 8.60 9.96 re f 312.93 248.94 8.60 9.96 re f 312.93 258.90 8.60 9.96 re f 312.93 268.86 8.60 9.96 re f 312.93 278.83 8.60 9.96 re f 312.93 288.79 8.60 9.96 re f /sRGB cs 0.667 0.847 0.910 scn 312.93 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 312.93 308.72 8.60 9.96 re f 312.93 318.68 8.60 9.96 re f 312.93 328.64 8.60 9.96 re f 312.93 338.61 8.60 9.96 re f 312.93 348.57 8.60 9.96 re f 312.93 358.53 8.60 9.96 re f 312.93 368.49 8.60 9.96 re f 312.93 378.46 8.60 9.96 re f 312.93 388.42 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 321.53 19.79 8.60 9.96 re f 321.53 29.75 8.60 9.96 re f 321.53 39.71 8.60 9.96 re f 321.53 49.67 8.60 9.96 re f 321.53 59.64 8.60 9.96 re f 321.53 69.60 8.60 9.96 re f 321.53 79.56 8.60 9.96 re f 321.53 89.53 8.60 9.96 re f 321.53 99.49 8.60 9.96 re f 321.53 109.45 8.60 9.96 re f 321.53 119.42 8.60 9.96 re f 321.53 129.38 8.60 9.96 re f 321.53 139.34 8.60 9.96 re f 321.53 149.31 8.60 9.96 re f 321.53 159.27 8.60 9.96 re f 321.53 169.23 8.60 9.96 re f /sRGB cs 0.686 0.035 0.149 scn 321.53 179.20 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 321.53 189.16 8.60 9.96 re f 321.53 199.12 8.60 9.96 re f 321.53 209.08 8.60 9.96 re f 321.53 219.05 8.60 9.96 re f 321.53 229.01 8.60 9.96 re f 321.53 238.97 8.60 9.96 re f 321.53 248.94 8.60 9.96 re f 321.53 258.90 8.60 9.96 re f 321.53 268.86 8.60 9.96 re f 321.53 278.83 8.60 9.96 re f 321.53 288.79 8.60 9.96 re f /sRGB cs 0.667 0.847 0.910 scn 321.53 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 321.53 308.72 8.60 9.96 re f 321.53 318.68 8.60 9.96 re f 321.53 328.64 8.60 9.96 re f 321.53 338.61 8.60 9.96 re f 321.53 348.57 8.60 9.96 re f 321.53 358.53 8.60 9.96 re f 321.53 368.49 8.60 9.96 re f 321.53 378.46 8.60 9.96 re f 321.53 388.42 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 330.12 19.79 8.60 9.96 re f 330.12 29.75 8.60 9.96 re f 330.12 39.71 8.60 9.96 re f 330.12 49.67 8.60 9.96 re f 330.12 59.64 8.60 9.96 re f 330.12 69.60 8.60 9.96 re f 330.12 79.56 8.60 9.96 re f 330.12 89.53 8.60 9.96 re f 330.12 99.49 8.60 9.96 re f 330.12 109.45 8.60 9.96 re f 330.12 119.42 8.60 9.96 re f 330.12 129.38 8.60 9.96 re f 330.12 139.34 8.60 9.96 re f 330.12 149.31 8.60 9.96 re f 330.12 159.27 8.60 9.96 re f 330.12 169.23 8.60 9.96 re f /sRGB cs 0.686 0.035 0.149 scn 330.12 179.20 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 330.12 189.16 8.60 9.96 re f 330.12 199.12 8.60 9.96 re f 330.12 209.08 8.60 9.96 re f 330.12 219.05 8.60 9.96 re f 330.12 229.01 8.60 9.96 re f 330.12 238.97 8.60 9.96 re f 330.12 248.94 8.60 9.96 re f 330.12 258.90 8.60 9.96 re f 330.12 268.86 8.60 9.96 re f 330.12 278.83 8.60 9.96 re f 330.12 288.79 8.60 9.96 re f /sRGB cs 0.667 0.847 0.910 scn 330.12 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 330.12 308.72 8.60 9.96 re f 330.12 318.68 8.60 9.96 re f 330.12 328.64 8.60 9.96 re f 330.12 338.61 8.60 9.96 re f 330.12 348.57 8.60 9.96 re f 330.12 358.53 8.60 9.96 re f 330.12 368.49 8.60 9.96 re f 330.12 378.46 8.60 9.96 re f 330.12 388.42 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 338.72 19.79 8.60 9.96 re f 338.72 29.75 8.60 9.96 re f 338.72 39.71 8.60 9.96 re f 338.72 49.67 8.60 9.96 re f 338.72 59.64 8.60 9.96 re f 338.72 69.60 8.60 9.96 re f 338.72 79.56 8.60 9.96 re f 338.72 89.53 8.60 9.96 re f 338.72 99.49 8.60 9.96 re f 338.72 109.45 8.60 9.96 re f 338.72 119.42 8.60 9.96 re f 338.72 129.38 8.60 9.96 re f 338.72 139.34 8.60 9.96 re f 338.72 149.31 8.60 9.96 re f 338.72 159.27 8.60 9.96 re f 338.72 169.23 8.60 9.96 re f /sRGB cs 0.686 0.035 0.149 scn 338.72 179.20 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 338.72 189.16 8.60 9.96 re f 338.72 199.12 8.60 9.96 re f 338.72 209.08 8.60 9.96 re f 338.72 219.05 8.60 9.96 re f 338.72 229.01 8.60 9.96 re f 338.72 238.97 8.60 9.96 re f 338.72 248.94 8.60 9.96 re f 338.72 258.90 8.60 9.96 re f 338.72 268.86 8.60 9.96 re f 338.72 278.83 8.60 9.96 re f 338.72 288.79 8.60 9.96 re f /sRGB cs 0.667 0.847 0.910 scn 338.72 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 338.72 308.72 8.60 9.96 re f 338.72 318.68 8.60 9.96 re f 338.72 328.64 8.60 9.96 re f 338.72 338.61 8.60 9.96 re f 338.72 348.57 8.60 9.96 re f 338.72 358.53 8.60 9.96 re f 338.72 368.49 8.60 9.96 re f 338.72 378.46 8.60 9.96 re f 338.72 388.42 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 347.32 19.79 8.60 9.96 re f 347.32 29.75 8.60 9.96 re f 347.32 39.71 8.60 9.96 re f 347.32 49.67 8.60 9.96 re f 347.32 59.64 8.60 9.96 re f 347.32 69.60 8.60 9.96 re f 347.32 79.56 8.60 9.96 re f 347.32 89.53 8.60 9.96 re f 347.32 99.49 8.60 9.96 re f 347.32 109.45 8.60 9.96 re f 347.32 119.42 8.60 9.96 re f 347.32 129.38 8.60 9.96 re f 347.32 139.34 8.60 9.96 re f 347.32 149.31 8.60 9.96 re f 347.32 159.27 8.60 9.96 re f 347.32 169.23 8.60 9.96 re f /sRGB cs 0.686 0.035 0.149 scn 347.32 179.20 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 347.32 189.16 8.60 9.96 re f 347.32 199.12 8.60 9.96 re f 347.32 209.08 8.60 9.96 re f 347.32 219.05 8.60 9.96 re f 347.32 229.01 8.60 9.96 re f 347.32 238.97 8.60 9.96 re f 347.32 248.94 8.60 9.96 re f 347.32 258.90 8.60 9.96 re f 347.32 268.86 8.60 9.96 re f 347.32 278.83 8.60 9.96 re f 347.32 288.79 8.60 9.96 re f /sRGB cs 0.667 0.847 0.910 scn 347.32 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 347.32 308.72 8.60 9.96 re f 347.32 318.68 8.60 9.96 re f 347.32 328.64 8.60 9.96 re f 347.32 338.61 8.60 9.96 re f 347.32 348.57 8.60 9.96 re f 347.32 358.53 8.60 9.96 re f 347.32 368.49 8.60 9.96 re f 347.32 378.46 8.60 9.96 re f 347.32 388.42 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 355.92 19.79 8.60 9.96 re f 355.92 29.75 8.60 9.96 re f 355.92 39.71 8.60 9.96 re f 355.92 49.67 8.60 9.96 re f 355.92 59.64 8.60 9.96 re f 355.92 69.60 8.60 9.96 re f 355.92 79.56 8.60 9.96 re f 355.92 89.53 8.60 9.96 re f 355.92 99.49 8.60 9.96 re f 355.92 109.45 8.60 9.96 re f 355.92 119.42 8.60 9.96 re f 355.92 129.38 8.60 9.96 re f 355.92 139.34 8.60 9.96 re f 355.92 149.31 8.60 9.96 re f 355.92 159.27 8.60 9.96 re f 355.92 169.23 8.60 9.96 re f /sRGB cs 0.686 0.035 0.149 scn 355.92 179.20 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 355.92 189.16 8.60 9.96 re f 355.92 199.12 8.60 9.96 re f 355.92 209.08 8.60 9.96 re f 355.92 219.05 8.60 9.96 re f 355.92 229.01 8.60 9.96 re f 355.92 238.97 8.60 9.96 re f 355.92 248.94 8.60 9.96 re f 355.92 258.90 8.60 9.96 re f 355.92 268.86 8.60 9.96 re f 355.92 278.83 8.60 9.96 re f 355.92 288.79 8.60 9.96 re f /sRGB cs 0.667 0.847 0.910 scn 355.92 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 355.92 308.72 8.60 9.96 re f 355.92 318.68 8.60 9.96 re f 355.92 328.64 8.60 9.96 re f 355.92 338.61 8.60 9.96 re f 355.92 348.57 8.60 9.96 re f 355.92 358.53 8.60 9.96 re f 355.92 368.49 8.60 9.96 re f 355.92 378.46 8.60 9.96 re f 355.92 388.42 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 364.51 19.79 8.60 9.96 re f 364.51 29.75 8.60 9.96 re f 364.51 39.71 8.60 9.96 re f 364.51 49.67 8.60 9.96 re f 364.51 59.64 8.60 9.96 re f 364.51 69.60 8.60 9.96 re f 364.51 79.56 8.60 9.96 re f 364.51 89.53 8.60 9.96 re f 364.51 99.49 8.60 9.96 re f 364.51 109.45 8.60 9.96 re f 364.51 119.42 8.60 9.96 re f 364.51 129.38 8.60 9.96 re f 364.51 139.34 8.60 9.96 re f 364.51 149.31 8.60 9.96 re f 364.51 159.27 8.60 9.96 re f 364.51 169.23 8.60 9.96 re f /sRGB cs 0.686 0.035 0.149 scn 364.51 179.20 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 364.51 189.16 8.60 9.96 re f 364.51 199.12 8.60 9.96 re f 364.51 209.08 8.60 9.96 re f 364.51 219.05 8.60 9.96 re f 364.51 229.01 8.60 9.96 re f 364.51 238.97 8.60 9.96 re f 364.51 248.94 8.60 9.96 re f 364.51 258.90 8.60 9.96 re f 364.51 268.86 8.60 9.96 re f 364.51 278.83 8.60 9.96 re f 364.51 288.79 8.60 9.96 re f /sRGB cs 0.667 0.847 0.910 scn 364.51 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 364.51 308.72 8.60 9.96 re f 364.51 318.68 8.60 9.96 re f 364.51 328.64 8.60 9.96 re f 364.51 338.61 8.60 9.96 re f 364.51 348.57 8.60 9.96 re f 364.51 358.53 8.60 9.96 re f 364.51 368.49 8.60 9.96 re f 364.51 378.46 8.60 9.96 re f 364.51 388.42 8.60 9.96 re f /sRGB cs 0.647 0.000 0.149 scn 373.11 19.79 8.60 9.96 re f 373.11 29.75 8.60 9.96 re f 373.11 39.71 8.60 9.96 re f 373.11 49.67 8.60 9.96 re f 373.11 59.64 8.60 9.96 re f 373.11 69.60 8.60 9.96 re f 373.11 79.56 8.60 9.96 re f 373.11 89.53 8.60 9.96 re f 373.11 99.49 8.60 9.96 re f 373.11 109.45 8.60 9.96 re f 373.11 119.42 8.60 9.96 re f 373.11 129.38 8.60 9.96 re f 373.11 139.34 8.60 9.96 re f 373.11 149.31 8.60 9.96 re f 373.11 159.27 8.60 9.96 re f 373.11 169.23 8.60 9.96 re f /sRGB cs 0.686 0.035 0.149 scn 373.11 179.20 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 373.11 189.16 8.60 9.96 re f 373.11 199.12 8.60 9.96 re f 373.11 209.08 8.60 9.96 re f 373.11 219.05 8.60 9.96 re f 373.11 229.01 8.60 9.96 re f 373.11 238.97 8.60 9.96 re f 373.11 248.94 8.60 9.96 re f 373.11 258.90 8.60 9.96 re f 373.11 268.86 8.60 9.96 re f 373.11 278.83 8.60 9.96 re f 373.11 288.79 8.60 9.96 re f /sRGB cs 0.667 0.847 0.910 scn 373.11 298.75 8.60 9.96 re f /sRGB cs 0.192 0.212 0.584 scn 373.11 308.72 8.60 9.96 re f 373.11 318.68 8.60 9.96 re f 373.11 328.64 8.60 9.96 re f 373.11 338.61 8.60 9.96 re f 373.11 348.57 8.60 9.96 re f 373.11 358.53 8.60 9.96 re f 373.11 368.49 8.60 9.96 re f 373.11 378.46 8.60 9.96 re f 373.11 388.42 8.60 9.96 re f Q q Q q BT /sRGB cs 0.000 0.000 0.000 scn /F2 1 Tf 0.00 -5.00 5.00 0.00 57.50 14.79 Tm (27) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 66.10 14.79 Tm (26) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 74.70 14.79 Tm (25) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 83.30 14.79 Tm (24) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 91.89 14.79 Tm (23) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 100.49 14.79 Tm (22) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 109.09 14.79 Tm (21) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 117.69 14.79 Tm (10) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 126.28 14.79 Tm (20) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 134.88 14.79 Tm (6) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 143.48 14.79 Tm (38) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 152.08 14.79 Tm (37) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 160.68 14.79 Tm (36) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 169.27 14.79 Tm (35) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 177.87 14.79 Tm (34) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 186.47 14.79 Tm (33) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 195.07 14.79 Tm (32) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 203.66 14.79 Tm (31) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 212.26 14.79 Tm (30) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 220.86 14.79 Tm (28) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 229.46 14.79 Tm (29) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 238.05 14.79 Tm (17) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 246.65 14.79 Tm (19) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 255.25 14.79 Tm (18) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 263.85 14.79 Tm (16) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 272.44 14.79 Tm (15) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 281.04 14.79 Tm (14) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 289.64 14.79 Tm (13) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 298.24 14.79 Tm (12) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 306.83 14.79 Tm (11) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 315.43 14.79 Tm (9) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 324.03 14.79 Tm (8) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 332.63 14.79 Tm (7) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 341.23 14.79 Tm (5) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 349.82 14.79 Tm (4) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 358.42 14.79 Tm (3) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 367.02 14.79 Tm (1) Tj ET BT /F2 1 Tf 0.00 -5.00 5.00 0.00 375.62 14.79 Tm (2) Tj ET Q q Q q BT /sRGB cs 0.000 0.000 0.000 scn /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 22.61 Tm (2) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 32.58 Tm (1) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 42.54 Tm (3) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 52.50 Tm (4) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 62.47 Tm (5) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 72.43 Tm (7) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 82.39 Tm (8) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 92.35 Tm (9) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 102.32 Tm (11) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 112.28 Tm (12) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 122.24 Tm (13) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 132.21 Tm (14) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 142.17 Tm (15) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 152.13 Tm (16) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 162.10 Tm (18) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 172.06 Tm (19) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 182.02 Tm (17) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 191.99 Tm (29) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 201.95 Tm (28) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 211.91 Tm (30) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 221.88 Tm (31) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 231.84 Tm (32) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 241.80 Tm (33) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 251.76 Tm (34) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 261.73 Tm (35) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 271.69 Tm (36) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 281.65 Tm (37) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 291.62 Tm (38) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 301.58 Tm (6) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 311.54 Tm (20) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 321.51 Tm (10) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 331.47 Tm (21) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 341.43 Tm (22) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 351.40 Tm (23) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 361.36 Tm (24) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 371.32 Tm (25) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 381.29 Tm (26) Tj ET BT /F2 1 Tf 6.00 0.00 -0.00 6.00 386.71 391.25 Tm (27) Tj ET Q q Q q /sRGB cs 0.616 0.624 1.000 scn 55.00 400.38 8.60 8.00 re f /sRGB cs 0.827 0.545 1.000 scn 55.00 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 63.60 400.38 8.60 8.00 re f /sRGB cs 0.827 0.545 1.000 scn 63.60 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 72.20 400.38 8.60 8.00 re f /sRGB cs 0.827 0.545 1.000 scn 72.20 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 80.79 400.38 8.60 8.00 re f /sRGB cs 0.827 0.545 1.000 scn 80.79 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 89.39 400.38 8.60 8.00 re f /sRGB cs 0.827 0.545 1.000 scn 89.39 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 97.99 400.38 8.60 8.00 re f /sRGB cs 0.827 0.545 1.000 scn 97.99 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 106.59 400.38 8.60 8.00 re f /sRGB cs 0.827 0.545 1.000 scn 106.59 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 115.18 400.38 8.60 8.00 re f /sRGB cs 0.227 0.694 1.000 scn 115.18 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 123.78 400.38 8.60 8.00 re f /sRGB cs 0.827 0.545 1.000 scn 123.78 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 132.38 400.38 8.60 8.00 re f /sRGB cs 0.227 0.694 1.000 scn 132.38 410.38 8.60 8.00 re f /sRGB cs 0.961 0.482 1.000 scn 140.98 400.38 8.60 8.00 re f 149.57 400.38 8.60 8.00 re f 158.17 400.38 8.60 8.00 re f 166.77 400.38 8.60 8.00 re f 175.37 400.38 8.60 8.00 re f 183.96 400.38 8.60 8.00 re f 192.56 400.38 8.60 8.00 re f 201.16 400.38 8.60 8.00 re f 209.76 400.38 8.60 8.00 re f 218.35 400.38 8.60 8.00 re f 226.95 400.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 235.55 400.38 8.60 8.00 re f /sRGB cs 0.227 0.694 1.000 scn 235.55 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 244.15 400.38 8.60 8.00 re f /sRGB cs 0.227 0.694 1.000 scn 244.15 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 252.75 400.38 8.60 8.00 re f /sRGB cs 0.227 0.694 1.000 scn 252.75 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 261.34 400.38 8.60 8.00 re f /sRGB cs 0.227 0.694 1.000 scn 261.34 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 269.94 400.38 8.60 8.00 re f /sRGB cs 0.227 0.694 1.000 scn 269.94 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 278.54 400.38 8.60 8.00 re f /sRGB cs 0.227 0.694 1.000 scn 278.54 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 287.14 400.38 8.60 8.00 re f /sRGB cs 0.227 0.694 1.000 scn 287.14 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 295.73 400.38 8.60 8.00 re f /sRGB cs 0.227 0.694 1.000 scn 295.73 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 304.33 400.38 8.60 8.00 re f /sRGB cs 0.227 0.694 1.000 scn 304.33 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 312.93 400.38 8.60 8.00 re f /sRGB cs 0.227 0.694 1.000 scn 312.93 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 321.53 400.38 8.60 8.00 re f /sRGB cs 0.227 0.694 1.000 scn 321.53 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 330.12 400.38 8.60 8.00 re f /sRGB cs 0.227 0.694 1.000 scn 330.12 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 338.72 400.38 8.60 8.00 re f /sRGB cs 0.227 0.694 1.000 scn 338.72 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 347.32 400.38 8.60 8.00 re f /sRGB cs 0.227 0.694 1.000 scn 347.32 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 355.92 400.38 8.60 8.00 re f /sRGB cs 0.227 0.694 1.000 scn 355.92 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 364.51 400.38 8.60 8.00 re f /sRGB cs 0.227 0.694 1.000 scn 364.51 410.38 8.60 8.00 re f /sRGB cs 0.616 0.624 1.000 scn 373.11 400.38 8.60 8.00 re f /sRGB cs 0.227 0.694 1.000 scn 373.11 410.38 8.60 8.00 re f Q q Q q BT /sRGB cs 0.000 0.000 0.000 scn /F3 1 Tf 10.00 0.00 -0.00 10.00 455.12 391.20 Tm (ALL.AML) Tj ET /sRGB cs 0.616 0.624 1.000 scn 455.12 380.43 7.18 7.18 re f BT /sRGB cs 0.000 0.000 0.000 scn /F2 1 Tf 10.00 0.00 -0.00 10.00 464.45 380.43 Tm (ALL) Tj ET /sRGB cs 0.961 0.482 1.000 scn 455.12 369.66 7.18 7.18 re f BT /sRGB cs 0.000 0.000 0.000 scn /F2 1 Tf 10.00 0.00 -0.00 10.00 464.45 369.66 Tm (AML) Tj ET BT /F3 1 Tf 10.00 0.00 -0.00 10.00 455.12 348.12 Tm (Cell) Tj ET /sRGB cs 0.227 0.694 1.000 scn 455.12 337.35 7.18 7.18 re f BT /sRGB cs 0.000 0.000 0.000 scn /F2 1 Tf 10.00 0.00 -0.00 10.00 464.45 337.35 Tm (B-cell) Tj ET /sRGB cs 0.827 0.545 1.000 scn 455.12 326.58 7.18 7.18 re f BT /sRGB cs 0.000 0.000 0.000 scn /F2 1 Tf 10.00 0.00 -0.00 10.00 464.45 326.58 Tm (T-cell) Tj ET Q q Q q /sRGB cs 0.192 0.212 0.584 scn 402.38 248.38 10.00 2.94 re f /sRGB cs 0.208 0.259 0.608 scn 402.38 251.33 10.00 2.94 re f /sRGB cs 0.220 0.310 0.631 scn 402.38 254.27 10.00 2.94 re f /sRGB cs 0.235 0.357 0.655 scn 402.38 257.21 10.00 2.94 re f /sRGB cs 0.255 0.408 0.678 scn 402.38 260.15 10.00 2.94 re f /sRGB cs 0.271 0.459 0.706 scn 402.38 263.09 10.00 2.94 re f /sRGB cs 0.306 0.502 0.725 scn 402.38 266.03 10.00 2.94 re f /sRGB cs 0.341 0.545 0.749 scn 402.38 268.97 10.00 2.94 re f /sRGB cs 0.380 0.588 0.773 scn 402.38 271.91 10.00 2.94 re f /sRGB cs 0.416 0.631 0.796 scn 402.38 274.85 10.00 2.94 re f /sRGB cs 0.455 0.678 0.820 scn 402.38 277.80 10.00 2.94 re f /sRGB cs 0.494 0.710 0.835 scn 402.38 280.74 10.00 2.94 re f /sRGB cs 0.537 0.745 0.855 scn 402.38 283.68 10.00 2.94 re f /sRGB cs 0.580 0.780 0.875 scn 402.38 286.62 10.00 2.94 re f /sRGB cs 0.627 0.816 0.894 scn 402.38 289.56 10.00 2.94 re f /sRGB cs 0.667 0.847 0.910 scn 402.38 292.50 10.00 2.94 re f /sRGB cs 0.710 0.871 0.922 scn 402.38 295.44 10.00 2.94 re f /sRGB cs 0.753 0.890 0.937 scn 402.38 298.38 10.00 2.94 re f /sRGB cs 0.792 0.910 0.949 scn 402.38 301.33 10.00 2.94 re f /sRGB cs 0.835 0.929 0.957 scn 402.38 304.27 10.00 2.94 re f /sRGB cs 0.878 0.953 0.973 scn 402.38 307.21 10.00 2.94 re f /sRGB cs 0.902 0.961 0.925 scn 402.38 310.15 10.00 2.94 re f /sRGB cs 0.925 0.969 0.882 scn 402.38 313.09 10.00 2.94 re f /sRGB cs 0.949 0.980 0.835 scn 402.38 316.03 10.00 2.94 re f /sRGB cs 0.973 0.988 0.792 scn 402.38 318.97 10.00 2.94 re f /sRGB cs 1.000 1.000 0.749 scn 402.38 321.91 10.00 2.94 re f /sRGB cs 0.996 0.973 0.710 scn 402.38 324.85 10.00 2.94 re f /sRGB cs 0.996 0.949 0.675 scn 402.38 327.80 10.00 2.94 re f /sRGB cs 0.996 0.925 0.635 scn 402.38 330.74 10.00 2.94 re f /sRGB cs 0.996 0.902 0.600 scn 402.38 333.68 10.00 2.94 re f /sRGB cs 0.996 0.878 0.565 scn 402.38 336.62 10.00 2.94 re f /sRGB cs 0.992 0.839 0.525 scn 402.38 339.56 10.00 2.94 re f /sRGB cs 0.992 0.800 0.490 scn 402.38 342.50 10.00 2.94 re f /sRGB cs 0.992 0.761 0.451 scn 402.38 345.44 10.00 2.94 re f /sRGB cs 0.992 0.722 0.416 scn 402.38 348.38 10.00 2.94 re f /sRGB cs 0.992 0.682 0.380 scn 402.38 351.33 10.00 2.94 re f /sRGB cs 0.984 0.631 0.357 scn 402.38 354.27 10.00 2.94 re f /sRGB cs 0.976 0.580 0.333 scn 402.38 357.21 10.00 2.94 re f /sRGB cs 0.969 0.529 0.310 scn 402.38 360.15 10.00 2.94 re f /sRGB cs 0.961 0.478 0.286 scn 402.38 363.09 10.00 2.94 re f /sRGB cs 0.957 0.427 0.263 scn 402.38 366.03 10.00 2.94 re f /sRGB cs 0.933 0.376 0.239 scn 402.38 368.97 10.00 2.94 re f /sRGB cs 0.910 0.329 0.216 scn 402.38 371.91 10.00 2.94 re f /sRGB cs 0.886 0.282 0.196 scn 402.38 374.85 10.00 2.94 re f /sRGB cs 0.863 0.235 0.173 scn 402.38 377.80 10.00 2.94 re f /sRGB cs 0.843 0.188 0.153 scn 402.38 380.74 10.00 2.94 re f /sRGB cs 0.800 0.149 0.149 scn 402.38 383.68 10.00 2.94 re f /sRGB cs 0.765 0.110 0.149 scn 402.38 386.62 10.00 2.94 re f /sRGB cs 0.725 0.075 0.149 scn 402.38 389.56 10.00 2.94 re f /sRGB cs 0.686 0.035 0.149 scn 402.38 392.50 10.00 2.94 re f /sRGB cs 0.647 0.000 0.149 scn 402.38 395.44 10.00 2.94 re f BT /sRGB cs 0.000 0.000 0.000 scn /F2 1 Tf 10.00 0.00 -0.00 10.00 414.38 244.79 Tm (0) Tj ET BT /F2 1 Tf 10.00 0.00 -0.00 10.00 414.38 274.79 Tm (0.2) Tj ET BT /F2 1 Tf 10.00 0.00 -0.00 10.00 414.38 304.79 Tm (0.4) Tj ET BT /F2 1 Tf 10.00 0.00 -0.00 10.00 414.38 334.79 Tm (0.6) Tj ET BT /F2 1 Tf 10.00 0.00 -0.00 10.00 414.38 364.79 Tm (0.8) Tj ET BT /F2 1 Tf 10.00 0.00 -0.00 10.00 414.38 394.79 Tm (1) Tj ET Q q Q q Q q BT /sRGB cs 0.000 0.000 0.000 scn /F3 1 Tf 12.00 0.00 -0.00 12.00 166.34 485.38 Tm (Consensus matrix) Tj ET Q q Q q Q q Q endstream endobj 9 0 obj 68611 endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 504 503] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /N 3 /Alternate /DeviceRGB /Length 9433 /Filter /ASCIIHexDecode >> stream 00 00 0c 48 4c 69 6e 6f 02 10 00 00 6d 6e 74 72 52 47 42 20 58 59 5a 20 07 ce 00 02 00 09 00 06 00 31 00 00 61 63 73 70 4d 53 46 54 00 00 00 00 49 45 43 20 73 52 47 42 00 00 00 00 00 00 00 00 00 00 00 00 00 00 f6 d6 00 01 00 00 00 00 d3 2d 48 50 20 20 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 11 63 70 72 74 00 00 01 50 00 00 00 33 64 65 73 63 00 00 01 84 00 00 00 6c 77 74 70 74 00 00 01 f0 00 00 00 14 62 6b 70 74 00 00 02 04 00 00 00 14 72 58 59 5a 00 00 02 18 00 00 00 14 67 58 59 5a 00 00 02 2c 00 00 00 14 62 58 59 5a 00 00 02 40 00 00 00 14 64 6d 6e 64 00 00 02 54 00 00 00 70 64 6d 64 64 00 00 02 c4 00 00 00 88 76 75 65 64 00 00 03 4c 00 00 00 86 76 69 65 77 00 00 03 d4 00 00 00 24 6c 75 6d 69 00 00 03 f8 00 00 00 14 6d 65 61 73 00 00 04 0c 00 00 00 24 74 65 63 68 00 00 04 30 00 00 00 0c 72 54 52 43 00 00 04 3c 00 00 08 0c 67 54 52 43 00 00 04 3c 00 00 08 0c 62 54 52 43 00 00 04 3c 00 00 08 0c 74 65 78 74 00 00 00 00 43 6f 70 79 72 69 67 68 74 20 28 63 29 20 31 39 39 38 20 48 65 77 6c 65 74 74 2d 50 61 63 6b 61 72 64 20 43 6f 6d 70 61 6e 79 00 00 64 65 73 63 00 00 00 00 00 00 00 12 73 52 47 42 20 49 45 43 36 31 39 36 36 2d 32 2e 31 00 00 00 00 00 00 00 00 00 00 00 12 73 52 47 42 20 49 45 43 36 31 39 36 36 2d 32 2e 31 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 58 59 5a 20 00 00 00 00 00 00 f3 51 00 01 00 00 00 01 16 cc 58 59 5a 20 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 58 59 5a 20 00 00 00 00 00 00 6f a2 00 00 38 f5 00 00 03 90 58 59 5a 20 00 00 00 00 00 00 62 99 00 00 b7 85 00 00 18 da 58 59 5a 20 00 00 00 00 00 00 24 a0 00 00 0f 84 00 00 b6 cf 64 65 73 63 00 00 00 00 00 00 00 16 49 45 43 20 68 74 74 70 3a 2f 2f 77 77 77 2e 69 65 63 2e 63 68 00 00 00 00 00 00 00 00 00 00 00 16 49 45 43 20 68 74 74 70 3a 2f 2f 77 77 77 2e 69 65 63 2e 63 68 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 64 65 73 63 00 00 00 00 00 00 00 2e 49 45 43 20 36 31 39 36 36 2d 32 2e 31 20 44 65 66 61 75 6c 74 20 52 47 42 20 63 6f 6c 6f 75 72 20 73 70 61 63 65 20 2d 20 73 52 47 42 00 00 00 00 00 00 00 00 00 00 00 2e 49 45 43 20 36 31 39 36 36 2d 32 2e 31 20 44 65 66 61 75 6c 74 20 52 47 42 20 63 6f 6c 6f 75 72 20 73 70 61 63 65 20 2d 20 73 52 47 42 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 64 65 73 63 00 00 00 00 00 00 00 2c 52 65 66 65 72 65 6e 63 65 20 56 69 65 77 69 6e 67 20 43 6f 6e 64 69 74 69 6f 6e 20 69 6e 20 49 45 43 36 31 39 36 36 2d 32 2e 31 00 00 00 00 00 00 00 00 00 00 00 2c 52 65 66 65 72 65 6e 63 65 20 56 69 65 77 69 6e 67 20 43 6f 6e 64 69 74 69 6f 6e 20 69 6e 20 49 45 43 36 31 39 36 36 2d 32 2e 31 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 76 69 65 77 00 00 00 00 00 13 a4 fe 00 14 5f 2e 00 10 cf 14 00 03 ed cc 00 04 13 0b 00 03 5c 9e 00 00 00 01 58 59 5a 20 00 00 00 00 00 4c 09 56 00 50 00 00 00 57 1f e7 6d 65 61 73 00 00 00 00 00 00 00 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 02 8f 00 00 00 02 73 69 67 20 00 00 00 00 43 52 54 20 63 75 72 76 00 00 00 00 00 00 04 00 00 00 00 05 00 0a 00 0f 00 14 00 19 00 1e 00 23 00 28 00 2d 00 32 00 37 00 3b 00 40 00 45 00 4a 00 4f 00 54 00 59 00 5e 00 63 00 68 00 6d 00 72 00 77 00 7c 00 81 00 86 00 8b 00 90 00 95 00 9a 00 9f 00 a4 00 a9 00 ae 00 b2 00 b7 00 bc 00 c1 00 c6 00 cb 00 d0 00 d5 00 db 00 e0 00 e5 00 eb 00 f0 00 f6 00 fb 01 01 01 07 01 0d 01 13 01 19 01 1f 01 25 01 2b 01 32 01 38 01 3e 01 45 01 4c 01 52 01 59 01 60 01 67 01 6e 01 75 01 7c 01 83 01 8b 01 92 01 9a 01 a1 01 a9 01 b1 01 b9 01 c1 01 c9 01 d1 01 d9 01 e1 01 e9 01 f2 01 fa 02 03 02 0c 02 14 02 1d 02 26 02 2f 02 38 02 41 02 4b 02 54 02 5d 02 67 02 71 02 7a 02 84 02 8e 02 98 02 a2 02 ac 02 b6 02 c1 02 cb 02 d5 02 e0 02 eb 02 f5 03 00 03 0b 03 16 03 21 03 2d 03 38 03 43 03 4f 03 5a 03 66 03 72 03 7e 03 8a 03 96 03 a2 03 ae 03 ba 03 c7 03 d3 03 e0 03 ec 03 f9 04 06 04 13 04 20 04 2d 04 3b 04 48 04 55 04 63 04 71 04 7e 04 8c 04 9a 04 a8 04 b6 04 c4 04 d3 04 e1 04 f0 04 fe 05 0d 05 1c 05 2b 05 3a 05 49 05 58 05 67 05 77 05 86 05 96 05 a6 05 b5 05 c5 05 d5 05 e5 05 f6 06 06 06 16 06 27 06 37 06 48 06 59 06 6a 06 7b 06 8c 06 9d 06 af 06 c0 06 d1 06 e3 06 f5 07 07 07 19 07 2b 07 3d 07 4f 07 61 07 74 07 86 07 99 07 ac 07 bf 07 d2 07 e5 07 f8 08 0b 08 1f 08 32 08 46 08 5a 08 6e 08 82 08 96 08 aa 08 be 08 d2 08 e7 08 fb 09 10 09 25 09 3a 09 4f 09 64 09 79 09 8f 09 a4 09 ba 09 cf 09 e5 09 fb 0a 11 0a 27 0a 3d 0a 54 0a 6a 0a 81 0a 98 0a ae 0a c5 0a dc 0a f3 0b 0b 0b 22 0b 39 0b 51 0b 69 0b 80 0b 98 0b b0 0b c8 0b e1 0b f9 0c 12 0c 2a 0c 43 0c 5c 0c 75 0c 8e 0c a7 0c c0 0c d9 0c f3 0d 0d 0d 26 0d 40 0d 5a 0d 74 0d 8e 0d a9 0d c3 0d de 0d f8 0e 13 0e 2e 0e 49 0e 64 0e 7f 0e 9b 0e b6 0e d2 0e ee 0f 09 0f 25 0f 41 0f 5e 0f 7a 0f 96 0f b3 0f cf 0f ec 10 09 10 26 10 43 10 61 10 7e 10 9b 10 b9 10 d7 10 f5 11 13 11 31 11 4f 11 6d 11 8c 11 aa 11 c9 11 e8 12 07 12 26 12 45 12 64 12 84 12 a3 12 c3 12 e3 13 03 13 23 13 43 13 63 13 83 13 a4 13 c5 13 e5 14 06 14 27 14 49 14 6a 14 8b 14 ad 14 ce 14 f0 15 12 15 34 15 56 15 78 15 9b 15 bd 15 e0 16 03 16 26 16 49 16 6c 16 8f 16 b2 16 d6 16 fa 17 1d 17 41 17 65 17 89 17 ae 17 d2 17 f7 18 1b 18 40 18 65 18 8a 18 af 18 d5 18 fa 19 20 19 45 19 6b 19 91 19 b7 19 dd 1a 04 1a 2a 1a 51 1a 77 1a 9e 1a c5 1a ec 1b 14 1b 3b 1b 63 1b 8a 1b b2 1b da 1c 02 1c 2a 1c 52 1c 7b 1c a3 1c cc 1c f5 1d 1e 1d 47 1d 70 1d 99 1d c3 1d ec 1e 16 1e 40 1e 6a 1e 94 1e be 1e e9 1f 13 1f 3e 1f 69 1f 94 1f bf 1f ea 20 15 20 41 20 6c 20 98 20 c4 20 f0 21 1c 21 48 21 75 21 a1 21 ce 21 fb 22 27 22 55 22 82 22 af 22 dd 23 0a 23 38 23 66 23 94 23 c2 23 f0 24 1f 24 4d 24 7c 24 ab 24 da 25 09 25 38 25 68 25 97 25 c7 25 f7 26 27 26 57 26 87 26 b7 26 e8 27 18 27 49 27 7a 27 ab 27 dc 28 0d 28 3f 28 71 28 a2 28 d4 29 06 29 38 29 6b 29 9d 29 d0 2a 02 2a 35 2a 68 2a 9b 2a cf 2b 02 2b 36 2b 69 2b 9d 2b d1 2c 05 2c 39 2c 6e 2c a2 2c d7 2d 0c 2d 41 2d 76 2d ab 2d e1 2e 16 2e 4c 2e 82 2e b7 2e ee 2f 24 2f 5a 2f 91 2f c7 2f fe 30 35 30 6c 30 a4 30 db 31 12 31 4a 31 82 31 ba 31 f2 32 2a 32 63 32 9b 32 d4 33 0d 33 46 33 7f 33 b8 33 f1 34 2b 34 65 34 9e 34 d8 35 13 35 4d 35 87 35 c2 35 fd 36 37 36 72 36 ae 36 e9 37 24 37 60 37 9c 37 d7 38 14 38 50 38 8c 38 c8 39 05 39 42 39 7f 39 bc 39 f9 3a 36 3a 74 3a b2 3a ef 3b 2d 3b 6b 3b aa 3b e8 3c 27 3c 65 3c a4 3c e3 3d 22 3d 61 3d a1 3d e0 3e 20 3e 60 3e a0 3e e0 3f 21 3f 61 3f a2 3f e2 40 23 40 64 40 a6 40 e7 41 29 41 6a 41 ac 41 ee 42 30 42 72 42 b5 42 f7 43 3a 43 7d 43 c0 44 03 44 47 44 8a 44 ce 45 12 45 55 45 9a 45 de 46 22 46 67 46 ab 46 f0 47 35 47 7b 47 c0 48 05 48 4b 48 91 48 d7 49 1d 49 63 49 a9 49 f0 4a 37 4a 7d 4a c4 4b 0c 4b 53 4b 9a 4b e2 4c 2a 4c 72 4c ba 4d 02 4d 4a 4d 93 4d dc 4e 25 4e 6e 4e b7 4f 00 4f 49 4f 93 4f dd 50 27 50 71 50 bb 51 06 51 50 51 9b 51 e6 52 31 52 7c 52 c7 53 13 53 5f 53 aa 53 f6 54 42 54 8f 54 db 55 28 55 75 55 c2 56 0f 56 5c 56 a9 56 f7 57 44 57 92 57 e0 58 2f 58 7d 58 cb 59 1a 59 69 59 b8 5a 07 5a 56 5a a6 5a f5 5b 45 5b 95 5b e5 5c 35 5c 86 5c d6 5d 27 5d 78 5d c9 5e 1a 5e 6c 5e bd 5f 0f 5f 61 5f b3 60 05 60 57 60 aa 60 fc 61 4f 61 a2 61 f5 62 49 62 9c 62 f0 63 43 63 97 63 eb 64 40 64 94 64 e9 65 3d 65 92 65 e7 66 3d 66 92 66 e8 67 3d 67 93 67 e9 68 3f 68 96 68 ec 69 43 69 9a 69 f1 6a 48 6a 9f 6a f7 6b 4f 6b a7 6b ff 6c 57 6c af 6d 08 6d 60 6d b9 6e 12 6e 6b 6e c4 6f 1e 6f 78 6f d1 70 2b 70 86 70 e0 71 3a 71 95 71 f0 72 4b 72 a6 73 01 73 5d 73 b8 74 14 74 70 74 cc 75 28 75 85 75 e1 76 3e 76 9b 76 f8 77 56 77 b3 78 11 78 6e 78 cc 79 2a 79 89 79 e7 7a 46 7a a5 7b 04 7b 63 7b c2 7c 21 7c 81 7c e1 7d 41 7d a1 7e 01 7e 62 7e c2 7f 23 7f 84 7f e5 80 47 80 a8 81 0a 81 6b 81 cd 82 30 82 92 82 f4 83 57 83 ba 84 1d 84 80 84 e3 85 47 85 ab 86 0e 86 72 86 d7 87 3b 87 9f 88 04 88 69 88 ce 89 33 89 99 89 fe 8a 64 8a ca 8b 30 8b 96 8b fc 8c 63 8c ca 8d 31 8d 98 8d ff 8e 66 8e ce 8f 36 8f 9e 90 06 90 6e 90 d6 91 3f 91 a8 92 11 92 7a 92 e3 93 4d 93 b6 94 20 94 8a 94 f4 95 5f 95 c9 96 34 96 9f 97 0a 97 75 97 e0 98 4c 98 b8 99 24 99 90 99 fc 9a 68 9a d5 9b 42 9b af 9c 1c 9c 89 9c f7 9d 64 9d d2 9e 40 9e ae 9f 1d 9f 8b 9f fa a0 69 a0 d8 a1 47 a1 b6 a2 26 a2 96 a3 06 a3 76 a3 e6 a4 56 a4 c7 a5 38 a5 a9 a6 1a a6 8b a6 fd a7 6e a7 e0 a8 52 a8 c4 a9 37 a9 a9 aa 1c aa 8f ab 02 ab 75 ab e9 ac 5c ac d0 ad 44 ad b8 ae 2d ae a1 af 16 af 8b b0 00 b0 75 b0 ea b1 60 b1 d6 b2 4b b2 c2 b3 38 b3 ae b4 25 b4 9c b5 13 b5 8a b6 01 b6 79 b6 f0 b7 68 b7 e0 b8 59 b8 d1 b9 4a b9 c2 ba 3b ba b5 bb 2e bb a7 bc 21 bc 9b bd 15 bd 8f be 0a be 84 be ff bf 7a bf f5 c0 70 c0 ec c1 67 c1 e3 c2 5f c2 db c3 58 c3 d4 c4 51 c4 ce c5 4b c5 c8 c6 46 c6 c3 c7 41 c7 bf c8 3d c8 bc c9 3a c9 b9 ca 38 ca b7 cb 36 cb b6 cc 35 cc b5 cd 35 cd b5 ce 36 ce b6 cf 37 cf b8 d0 39 d0 ba d1 3c d1 be d2 3f d2 c1 d3 44 d3 c6 d4 49 d4 cb d5 4e d5 d1 d6 55 d6 d8 d7 5c d7 e0 d8 64 d8 e8 d9 6c d9 f1 da 76 da fb db 80 dc 05 dc 8a dd 10 dd 96 de 1c de a2 df 29 df af e0 36 e0 bd e1 44 e1 cc e2 53 e2 db e3 63 e3 eb e4 73 e4 fc e5 84 e6 0d e6 96 e7 1f e7 a9 e8 32 e8 bc e9 46 e9 d0 ea 5b ea e5 eb 70 eb fb ec 86 ed 11 ed 9c ee 28 ee b4 ef 40 ef cc f0 58 f0 e5 f1 72 f1 ff f2 8c f3 19 f3 a7 f4 34 f4 c2 f5 50 f5 de f6 6d f6 fb f7 8a f8 19 f8 a8 f9 38 f9 c7 fa 57 fa e7 fb 77 fc 07 fc 98 fd 29 fd ba fe 4b fe dc ff 6d ff ff > endstream endobj 10 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 10 0 R >> endobj 12 0 obj << /Type /Font /Subtype /Type1 /Name /F3 /BaseFont /Helvetica-Bold /Encoding 10 0 R >> endobj xref 0 13 0000000000 65535 f 0000000021 00000 n 0000000164 00000 n 0000068977 00000 n 0000069060 00000 n 0000069183 00000 n 0000069216 00000 n 0000000213 00000 n 0000000293 00000 n 0000068956 00000 n 0000078752 00000 n 0000079010 00000 n 0000079108 00000 n trailer << /Size 13 /Info 1 0 R /Root 2 0 R >> startxref 79211 %%EOF NMF/vignettes/.install_extras0000644000176000001440000000001512234465004015763 0ustar ripleyusersconsensus.pdfNMF/vignettes/NMF-vignette.Rnw0000644000176000001440000015575612305630424015707 0ustar ripleyusers%\VignetteIndexEntry{An introduction to the package NMF} %\VignetteDepends{utils,NMF,Biobase,bigmemory,xtable,RColorBrewer,knitr,bibtex} %\VignetteKeyword{math} %\VignetteCompiler{knitr} %\VignetteEngine{knitr::knitr} \documentclass[a4paper]{article} %\usepackage[OT1]{fontenc} \usepackage[colorlinks]{hyperref} % for hyperlinks \usepackage{a4wide} \usepackage{xspace} \usepackage[all]{hypcap} % for linking to the top of the figures or tables % add preamble from pkgmaker <>= pkgmaker::latex_preamble() @ \newcommand{\nmfpack}{\Rpkg{NMF}} \newcommand{\RcppOctave}{\textit{RcppOctave}\xspace} \newcommand{\matlab}{Matlab$^\circledR$\xspace} \newcommand{\MATLAB}{\matlab} \newcommand{\gauss}{GAUSS$^\circledR$\xspace} \newcommand{\graphwidth}{0.9\columnwidth} \newcommand{\refeqn}[1]{(\ref{#1})} % REFERENCES \usepackage[citestyle=authoryear-icomp , doi=true , url=true , maxnames=1 , maxbibnames=15 , backref=true , backend=bibtex]{biblatex} \AtEveryCitekey{\clearfield{url}} <>= pkgmaker::latex_bibliography('NMF') @ \newcommand{\citet}[1]{\textcite{#1}} \renewcommand{\cite}[1]{\parencite{#1}} \DefineBibliographyStrings{english}{% backrefpage = {see p.}, % for single page number backrefpages = {see pp.} % for multiple page numbers } %% % boxed figures \usepackage{float} \floatstyle{boxed} \restylefloat{figure} \usepackage{array} \usepackage{tabularx} \usepackage{xcolor} \usepackage{url} \urlstyle{rm} <>= set.seed(123456) library(knitr) knit_hooks$set(try = pkgmaker::hook_try, backspace = pkgmaker::hook_backspace()) @ % use cleveref for automatic reference label formatting \usepackage[capitalise, noabbrev]{cleveref} % multiple columns \usepackage{multicol} % define commands for notes \usepackage{todonotes} \newcommand{\nbnote}[1]{\todo[inline, backgroundcolor=blue!20!white]{\scriptsize\textsf{\textbf{NB:} #1}}\ \\} % default graphic width \setkeys{Gin}{width=0.95\textwidth} \begin{document} <>= # Load library(NMF) # limit number of cores used nmf.options(cores = 2) @ \title{An introduction to NMF package\\ \small Version \Sexpr{utils::packageVersion('NMF')}} \author{Renaud Gaujoux} % \\Address Computational Biology - University of Cape Town, South Africa, \maketitle This vignette presents the \citeCRANpkg{NMF}, which implements a framework for Nonnegative Matrix Factorization (NMF) algorithms in R \cite{R}. The objective is to provide an implementation of some standard algorithms, while allowing the user to easily implement new methods that integrate into a common framework, which facilitates analysis, result visualisation or performance benchmarking. If you use the package \nmfpack in your analysis and publications please cite: \bigskip \todo[inline, backgroundcolor=blue!10!white]{\fullcite{Rpackage:NMF}} Note that the \nmfpack includes several NMF algorithms, published by different authors. Please make sure to also cite the paper(s) associated with the algorithm(s) you used. Citations for those can be found in \cref{tab:algo} and in the dedicated help pages \code{?gedAlgorithm.}, e.g., \code{?gedAlgorithm.SNMF\_R}. \bigskip \paragraph{Installation:} The latest stable version of the package can be installed from any \href{http://cran.r-project.org}{CRAN} repository mirror: <>= # Install install.packages('NMF') # Load library(NMF) @ The \nmfpack is a project hosted on \emph{R-forge}\footnote{\url{https://r-forge.r-project.org/projects/nmf}}. The latest development version is available from \url{https://r-forge.r-project.org/R/?group_id=649} and may be installed from there\footnote{\code{install.packages("NMF", repos = "http://R-Forge.R-project.org")}}. \paragraph{Support:} UseRs interested in this package are encouraged to subscribe to the user mailing list (\href{https://lists.r-forge.r-project.org/mailman/listinfo/nmf-user}{nmf-user@lists.r-forge.r-project.org}), which is the preferred channel for enquiries, bug reports, feature requests, suggestions or NMF-related discussions. This will enable better tracking as well as fruitful community exchange. \paragraph{Important:} Note that some of the classes defined in the NMF package have gained new slots. If you need to load objects saved in versions prior 0.8.14 please use: <>= # eg., load from some RData file load('object.RData') # update class definition object <- nmfObject(object) @ \pagebreak \tableofcontents \pagebreak \section{Overview} \subsection{Package features} This section provides a quick overview of the \nmfpack package's features. \Cref{sec:usecase} provides more details, as well as sample code on how to actually perform common tasks in NMF analysis. <>= nalgo <- length(nmfAlgorithm()) nseed <- length(nmfSeed()) @ The \nmfpack package provides: \begin{itemize} \item \Sexpr{nalgo} built-in algorithms; \item \Sexpr{nseed} built-in seeding methods; \item Single interface to perform all algorithms, and combine them with the seeding methods; \item Provides a common framework to test, compare and develop NMF methods; \item Accept custom algorithms and seeding methods; \item Plotting utility functions to visualize and help in the interpretation of the results; \item Transparent parallel computations; \item Optimized and memory efficient C++ implementations of the standard algorithms; \item Optional layer for bioinformatics using BioConductor \cite{Gentleman2004}; \end{itemize} \subsection{Nonnegative Matrix Factorization} This section gives a formal definition for Nonnegative Matrix Factorization problems, and defines the notations used throughout the vignette. Let $X$ be a $n \times p$ non-negative matrix, (i.e with $x_{ij} \geq 0$, denoted $X \geq 0$), and $r > 0$ an integer. Non-negative Matrix Factorization (NMF) consists in finding an approximation \begin{equation} X \approx W H\ , \label{NMFstd} \end{equation} where $W, H$ are $n\times r$ and $r \times p$ non-negative matrices, respectively. In practice, the factorization rank $r$ is often chosen such that $r \ll \min(n, p)$. The objective behind this choice is to summarize and split the information contained in $X$ into $r$ factors: the columns of $W$. Depending on the application field, these factors are given different names: basis images, metagenes, source signals. In this vignette we equivalently and alternatively use the terms \emph{basis matrix} or \emph{metagenes} to refer to matrix $W$, and \emph{mixture coefficient matrix} and \emph{metagene expression profiles} to refer to matrix $H$. The main approach to NMF is to estimate matrices $W$ and $H$ as a local minimum: \begin{equation} \min_{W, H \geq 0}\ \underbrace{[D(X, WH) + R(W, H)]}_{=F(W,H)} \label{nmf_min} \end{equation} where \begin{itemize} \item $D$ is a loss function that measures the quality of the approximation. Common loss functions are based on either the Frobenius distance $$D: A,B\mapsto \frac{Tr(AB^t)}{2} = \frac{1}{2} \sum_{ij} (a_{ij} - b_{ij})^2,$$ or the Kullback-Leibler divergence. $$D: A,B\mapsto KL(A||B) = \sum_{i,j} a_{ij} \log \frac{a_{ij}}{b_{ij}} - a_{ij} + b_{ij}.$$ \item $R$ is an optional regularization function, defined to enforce desirable properties on matrices $W$ and $H$, such as smoothness or sparsity \cite{Cichocki2008}. \end{itemize} \subsection{Algorithms} NMF algorithms generally solve problem \refeqn{nmf_min} iteratively, by building a sequence of matrices $(W_k,H_k)$ that reduces at each step the value of the objective function $F$. Beside some variations in the specification of $F$, they also differ in the optimization techniques that are used to compute the updates for $(W_k,H_k)$. For reviews on NMF algorithms see \cite{Berry2007, Chu2004} and references therein. The \nmfpack package implements a number of published algorithms, and provides a general framework to implement other ones. \Cref{tab:algo} gives a short description of each one of the built-in algorithms: The built-in algorithms are listed or retrieved with function \code{nmfAlgorithm}. A given algorithm is retrieved by its name (a \code{character} key), that is partially matched against the list of available algorithms: <>= # list all available algorithms nmfAlgorithm() # retrieve a specific algorithm: 'brunet' nmfAlgorithm('brunet') # partial match is also fine identical(nmfAlgorithm('br'), nmfAlgorithm('brunet')) @ \begin{table}[h!t] \begin{tabularx}{\textwidth}{lX} \hline Key & Description\\ \hline \code{brunet} & Standard NMF. Based on Kullback-Leibler divergence, it uses simple multiplicative updates from \cite{Lee2001}, enhanced to avoid numerical underflow. \begin{eqnarray} H_{kj} & \leftarrow & H_{kj} \frac{\left( \sum_l \frac{W_{lk} V_{lj}}{(WH)_{lj}} \right)}{ \sum_l W_{lk} }\\ W_{ik} & \leftarrow & W_{ik} \frac{ \sum_l [H_{kl} A_{il} / (WH)_{il} ] }{\sum_l H_{kl} } \end{eqnarray} \textbf{Reference:} \cite{Brunet2004}\\ \hline % \code{lee} & Standard NMF. Based on euclidean distance, it uses simple multiplicative updates \begin{eqnarray} H_{kj} & \leftarrow & H_{kj} \frac{(W^T V)_{kj}}{(W^T W H)_{kj}}\\ W_{ik} & \leftarrow & W_{ik} \frac{(V H^T)_{ik}}{(W H H^T)_{ik}} \end{eqnarray} \textbf{Reference:} \cite{Lee2001}\\ \hline % %\code{lnmf} & Local Nonnegative Matrix Factorization. Based on a %regularized Kullback-Leibler divergence, it uses a modified version of %Lee and Seung's multiplicative updates. % %\textbf{Reference:} \cite{Li2001}\\ % \code{nsNMF} & Non-smooth NMF. Uses a modified version of Lee and Seung's multiplicative updates for Kullback-Leibler divergence to fit a extension of the standard NMF model. It is meant to give sparser results. \textbf{Reference:} \cite{Pascual-Montano2006}\\ \hline % \code{offset} & Uses a modified version of Lee and Seung's multiplicative updates for euclidean distance, to fit a NMF model that includes an intercept. \textbf{Reference:} \cite{Badea2008}\\ \hline % \code{pe-nmf} & Pattern-Expression NMF. Uses multiplicative updates to minimize an objective function based on the Euclidean distance and regularized for effective expression of patterns with basis vectors. \textbf{Reference:} \cite{Zhang2008}\\ \hline % \code{snmf/r}, \code{snmf/l} & Alternating Least Square (ALS) approach. It is meant to be very fast compared to other approaches. \textbf{Reference:} \cite{KimH2007}\\ \hline \end{tabularx} \caption{Description of the implemented NMF algorithms. The first column gives the key to use in the call to the \texttt{nmf} function.\label{tab:algo}} \end{table} \subsection{Initialization: seeding methods} NMF algorithms need to be initialized with a seed (i.e. a value for $W_0$ and/or $H_0$\footnote{Some algorithms only need one matrix factor (either $W$ or $H$) to be initialized. See for example the SNMF/R(L) algorithm of Kim and Park \cite{KimH2007}.}), from which to start the iteration process. Because there is no global minimization algorithm, and due to the problem's high dimensionality, the choice of the initialization is in fact very important to ensure meaningful results. The more common seeding method is to use a random starting point, where the entries of $W$ and/or $H$ are drawn from a uniform distribution, usually within the same range as the target matrix's entries. This method is very simple to implement. However, a drawback is that to achieve stability one has to perform multiple runs, each with a different starting point. This significantly increases the computation time needed to obtain the desired factorization. To tackle this problem, some methods have been proposed so as to compute a reasonable starting point from the target matrix itself. Their objective is to produce deterministic algorithms that need to run only once, still giving meaningful results. For a review on some existing NMF initializations see \cite{Albright2006} and references therein. The \nmfpack\ package implements a number of already published seeding methods, and provides a general framework to implement other ones. \Cref{tab:seed} gives a short description of each one of the built-in seeding methods: The built-in seeding methods are listed or retrieved with function \code{nmfSeed}. A given seeding method is retrieved by its name (a \code{character} key) that is partially matched against the list of available seeding methods: <>= # list all available seeding methods nmfSeed() # retrieve a specific method: 'nndsvd' nmfSeed('nndsvd') # partial match is also fine identical(nmfSeed('nn'), nmfSeed('nndsvd')) @ \begin{table}[h!t] \begin{tabularx}{\textwidth}{lX} \hline Key & Description\\ \hline \code{ica} & Uses the result of an Independent Component Analysis (ICA) (from the \citeCRANpkg{fastICA}). Only the positive part of the result are used to initialize the factors.\\ \hline % \code{nnsvd} & 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 utilizing an algebraic property of unit rank matrices. It is well suited to initialize NMF algorithms with sparse factors. Simple practical variants of the algorithm allows to generate dense factors. \textbf{Reference:} \cite{Boutsidis2008}\\ \hline % \code{none} & Fix seed. This method allows the user to manually provide initial values for both matrix factors.\\ \hline % \code{random} & The entries of each factors are drawn from a uniform distribution over $[0, max(V)]$, where $V$ is the target matrix.\\ \hline \end{tabularx} \caption{Description of the implemented seeding methods to initialize NMF algorithms. The first column gives the key to use in the call to the \texttt{nmf} function.\label{tab:seed}} \end{table} \subsection{How to run NMF algorithms} Method \code{nmf} provides a single interface to run NMF algorithms. It can directly perform NMF on object of class \code{matrix} or \code{data.frame} and \code{ExpressionSet} -- if the \citeBioCpkg{Biobase} is installed. The interface has four main parameters: \medskip \fbox{\code{nmf(x, rank, method, seed, ...)}} \begin{description} \item[\code{x}] is the target \code{matrix}, \code{data.frame} or \code{ExpressionSet} \footnote{\code{ExpressionSet} is the base class for handling microarray data in BioConductor, and is defined in the \pkgname{Biobase} package.} \item[\code{rank}] is the factorization rank, i.e. the number of columns in matrix $W$. \item[\code{method}] is the algorithm used to estimate the factorization. The default algorithm is given by the package specific option \code{'default.algorithm'}, which defaults to \code{'brunet'} on installation \cite{Brunet2004}. \item[\code{seed}] is the seeding method used to compute the starting point. The default method is given by the package specific option \code{'default.seed'}, which defaults to \code{'random'} on initialization (see method \code{?rnmf} for details on its implementation). \end{description} See also \code{?nmf} for details on the interface and extra parameters. \subsection{Performances} Since version 0.4, some built-in algorithms are optimized in C++, which results in a significant speed-up and a more efficient memory management, especially on large scale data. The older R versions of the concerned algorithms are still available, and accessible by adding the prefix \code{'.R\#'} to the algorithms' access keys (e.g. the key \code{'.R\#offset'} corresponds to the R implementation of NMF with offset \cite{Badea2008}). Moreover they do not show up in the listing returned by the \code{nmfAlgorithm} function, unless argument \code{all=TRUE}: <>= nmfAlgorithm(all=TRUE) # to get all the algorithms that have a secondary R version nmfAlgorithm(version='R') @ \Cref{tab:perf} shows the speed-up achieved by the algorithms that benefit from the optimized code. All algorithms were run once with a factorization rank equal to 3, on the Golub data set which contains a $5000\times 38$ gene expression matrix. The same numeric random seed (\code{seed=123456}) was used for all factorizations. The columns \emph{C} and \emph{R} show the elapsed time (in seconds) achieved by the C++ version and R version respectively. The column \emph{Speed.up} contains the ratio $R/C$. <>= # retrieve all the methods that have a secondary R version meth <- nmfAlgorithm(version='R') meth <- c(names(meth), meth) meth # load the Golub data data(esGolub) # compute NMF for each method res <- nmf(esGolub, 3, meth, seed=123456) # extract only the elapsed time t <- sapply(res, runtime)[3,] @ <>= # speed-up m <- length(res)/2 su <- cbind( C=t[1:m], R=t[-(1:m)], Speed.up=t[-(1:m)]/t[1:m]) library(xtable) xtable(su, caption='Performance speed up achieved by the optimized C++ implementation for some of the NMF algorithms.', label='tab:perf') @ \subsection{How to cite the package NMF} To view all the package's bibtex citations, including all vignette(s) and manual(s): <>= # plain text citation('NMF') # or to get the bibtex entries toBibtex(citation('NMF')) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Use case: Golub dataset}\label{sec:usecase} We illustrate the functionalities and the usage of the \nmfpack package on the -- now standard -- Golub dataset on leukemia. It was used in several papers on NMF \cite{Brunet2004, Gao2005} and is included in the \nmfpack package's data, wrapped into an \code{ExpressionSet} object. For performance reason we use here only the first 200 genes. Therefore the results shown in the following are not meant to be biologically meaningful, but only illustrative: <>= data(esGolub) esGolub esGolub <- esGolub[1:200,] # remove the uneeded variable 'Sample' from the phenotypic data esGolub$Sample <- NULL @ % TODO: pass to 50 genes for dev \paragraph{Note:} To run this example, the \code{Biobase} package from BioConductor is required. \subsection{Single run}\label{sec:single_run} \subsubsection{Performing a single run} To run the default NMF algorithm on data \code{esGolub} with a factorization rank of 3, we call: <>= # default NMF algorithm res <- nmf(esGolub, 3) @ Here we did not specify either the algorithm or the seeding method, so that the computation is done using the default algorithm and is seeded by the default seeding methods. These defaults are set in the package specific options \code{'default.algorithm'} and \code{'default.seed'} respectively. See also \cref{sec:algo,sec:seed} for how to explicitly specify the algorithm and/or the seeding method. \subsubsection{Handling the result} The result of a single NMF run is an object of class \code{NMFfit}, that holds both the fitted NMF model and data about the run: <>= res @ The fitted model can be retrieved via method \code{fit}, which returns an object of class \code{NMF}: <>= fit(res) @ The estimated target matrix can be retrieved via the generic method \code{fitted}, which returns a -- generally big -- \code{matrix}: <>= V.hat <- fitted(res) dim(V.hat) @ Quality and performance measures about the factorization are computed by method \code{summary}: <>= summary(res) # More quality measures are computed, if the target matrix is provided: summary(res, target=esGolub) @ If there is some prior knowledge of classes present in the data, some other measures about the unsupervised clustering's performance are computed (purity, entropy, \ldots). Here we use the phenotypic variable \code{Cell} found in the Golub dataset, that gives the samples' cell-types (it is a factor with levels: T-cell, B-cell or \code{NA}): <>= summary(res, class=esGolub$Cell) @ The basis matrix (i.e. matrix $W$ or the metagenes) and the mixture coefficient matrix (i.e matrix $H$ or the metagene expression profiles) are retrieved using methods \code{basis} and \code{coef} respectively: <>= # get matrix W w <- basis(res) dim(w) # get matrix H h <- coef(res) dim(h) @ If one wants to keep only part of the factorization, one can directly subset on the \code{NMF} object on features and samples (separately or simultaneously). The result is a \code{NMF} object composed of the selected rows and/or columns: <>= # keep only the first 10 features res.subset <- res[1:10,] class(res.subset) dim(res.subset) # keep only the first 10 samples dim(res[,1:10]) # subset both features and samples: dim(res[1:20,1:10]) @ \subsubsection{Extracting metagene-specific features} In general NMF matrix factors are sparse, so that the metagenes can usually be characterized by a relatively small set of genes. Those are determined based on their relative contribution to each metagene. Kim and Park \cite{KimH2007} defined a procedure to extract the relevant genes for each metagene, based on a gene scoring schema. The NMF package implements this procedure in methods \code{featureScore} and \code{extractFeature}: <>= # only compute the scores s <- featureScore(res) summary(s) # compute the scores and characterize each metagene s <- extractFeatures(res) str(s) @ \subsection{Specifying the algorithm}\label{sec:algo} \subsubsection{Built-in algorithms} The \nmfpack package provides a number of built-in algorithms, that are listed or retrieved by function \code{nmfAlgorithm}. Each algorithm is identified by a unique name. The following algorithms are currently implemented (cf. \cref{tab:algo} for more details): <>= nmfAlgorithm() @ %\begin{tech} %Internally, all algorithms are stored in objects that inherit from class %\code{NMFStrategy}. This class defines the minimum interface %\end{tech} The algorithm used to compute the NMF is specified in the third argument (\code{method}). For example, to use the NMF algorithm from Lee and Seung \cite{Lee2001} based on the Frobenius euclidean norm, one make the following call: <>= # using Lee and Seung's algorithm res <- nmf(esGolub, 3, 'lee') algorithm(res) @ To use the Nonsmooth NMF algorithm from \cite{Pascual-Montano2006}: <>= # using the Nonsmooth NMF algorithm with parameter theta=0.7 res <- nmf(esGolub, 3, 'ns', theta=0.7) algorithm(res) fit(res) @ Or to use the PE-NMF algorithm from \cite{Zhang2008}: <>= # using the PE-NMF algorithm with parameters alpha=0.01, beta=1 res <- nmf(esGolub, 3, 'pe', alpha=0.01, beta=1) res @ %\begin{tech} %Although the last two calls looks similar these are handled % %In the case of the nsNMF algorithm, the fitted model is an object of class %\code{NMFns} that extends the standard NMF model \code{NMFstd}, as it introduces %a smoothing matrix $S$, parametrised by a real number $\theta \in [0,1]$, such %that the fitted model is: %$$ %V \approx W S(\theta) H. %$$ % %Hence the call to function \code{nmf}, parameter $\theta$ is used to % %\end{tech} \subsubsection{Custom algorithms} The \nmfpack package provides the user the possibility to define his own algorithms, and benefit from all the functionalities available in the NMF framework. There are only few contraints on the way the custom algorithm must be defined. See the details in \cref{sec:algo_custom}. \subsection{Specifying the seeding method}\label{sec:seed} The seeding method used to compute the starting point for the chosen algorithm can be set via argument \code{seed}. Note that if the seeding method is deterministic there is no need to perform multiple run anymore. \subsubsection{Built-in seeding methods} Similarly to the algorithms, the \code{nmfSeed} function can be used to list or retrieve the built-in seeding methods. The following seeding methods are currently implemented: <>= nmfSeed() @ To use a specific method to seed the computation of a factorization, one simply passes its name to \code{nmf}: <>= res <- nmf(esGolub, 3, seed='nndsvd') res @ \subsubsection{Numerical seed}\label{sec:numseed} Another possibility, useful when comparing methods or reproducing results, is to set the random number generator (RNG) by passing a numerical value in argument \code{seed}. This value is used to set the state of the RNG, and the initialization is performed by the built-in seeding method \code{'random'}. When the function \code{nmf} exits, the value of the random seed (\code{.Random.seed}) is restored to its original state -- as before the call. In the case of a single run (i.e. with \code{nrun=1}), the default is to use the current RNG, set with the R core function \code{set.seed}. In the case of multiple runs, the computations use RNGstream, as provided by the core RNG ``L'Ecuyer-CMRG" \cite{Lecuyer2002}, which generates multiple independent random streams (one per run). This ensures the complete reproducibility of any given set of runs, even when their computation is performed in parallel. Since RNGstream requires a 6-length numeric seed, a random one is generated if only a single numeric value is passed to \code{seed}. Moreover, single runs can also use RNGstream by passing a 6-length seed. <>= # single run and single numeric seed res <- nmf(esGolub, 3, seed=123456) showRNG(res) # multiple runs and single numeric seed res <- nmf(esGolub, 3, seed=123456, nrun=2) showRNG(res) # single run with a 6-length seed res <- nmf(esGolub, 3, seed=rep(123456, 6)) showRNG(res) @ \nbnote{To show the RNG changes happening during the computation use \texttt{.options='v4'} to turn on verbosity at level 4.\\ In versions prior 0.6, one could specify option \texttt{restore.seed=FALSE} or \texttt{'-r'}, this option is now deprecated.} \subsubsection{Fixed factorization} Yet another option is to completely specify the initial factorization, by passing values for matrices $W$ and $H$: <>= # initialize a "constant" factorization based on the target dimension init <- nmfModel(3, esGolub, W=0.5, H=0.3) head(basis(init)) # fit using this NMF model as a seed res <- nmf(esGolub, 3, seed=init) @ \subsubsection{Custom function} The \nmfpack package provides the user the possibility to define his own seeding method, and benefit from all the functionalities available in the NMF framework. There are only few contraints on the way the custom seeding method must be defined. See the details in \cref{sec:seed_custom}. \subsection{Multiple runs} When the seeding method is stochastic, multiple runs are usually required to achieve stability or a resonable result. This can be done by setting argument \code{nrun} to the desired value. For performance reason we use \code{nrun=5} here, but a typical choice would lies between 100 and 200: <>= res.multirun <- nmf(esGolub, 3, nrun=5) res.multirun @ By default, the returned object only contains the best fit over all the runs. That is the factorization that achieved the lowest approximation error (i.e. the lowest objective value). Even during the computation, only the current best factorization is kept in memory. This limits the memory requirement for performing multiple runs, which in turn allows to perform more runs. The object \code{res.multirun} is of class \code{NMFfitX1} that extends class \code{NMFfit}, the class returned by single NMF runs. It can therefore be handled as the result of a single run and benefit from all the methods defined for single run results. \medskip If one is interested in keeping the results from all the runs, one can set the option \code{keep.all=TRUE}: <>= # explicitly setting the option keep.all to TRUE res <- nmf(esGolub, 3, nrun=5, .options=list(keep.all=TRUE)) res @ <>= # or using letter code 'k' in argument .options nmf(esGolub, 3, nrun=5, .options='k') @ In this case, the result is an object of class \code{NMFfitXn} that also inherits from class \code{list}. Note that keeping all the results may be memory consuming. For example, a 3-rank \code{NMF} fit\footnote{i.e. the result of a single NMF run with rank equal 3.} for the Golub gene expression matrix ($5000 \times 38$) takes about \Sexpr{round(object.size(fit(res.multirun))/1000)}Kb\footnote{This size might change depending on the architecture (32 or 64 bits)}. \subsection{Parallel computations}\label{multicore} To speed-up the analysis whenever possible, the \nmfpack package implements transparent parallel computations when run on multi-core machines. It uses the \code{foreach} framework developed by REvolution Computing \citeCRANpkg{foreach}, together with the related \code{doParallel} parallel backend from the \citeCRANpkg{doParallel} -- based on the \pkgname{parallel} package -- to make use of all the CPUs available on the system, with each core simultaneously performing part of the runs. \subsubsection{Memory considerations} Running multicore computations increases the required memory linearly with the number of cores used. When only the best run is of interest, memory usage is optimized to only keep the current best factorization. On non-Windows machine, further speed improvement are achieved by using shared memory and mutex objects from the \citeCRANpkg{bigmemory} and the \citeCRANpkg{synchronicity}. \subsubsection{Parallel foreach backends} The default parallel backend used by the \code{nmf} function is defined by the package specific option \code{'pbackend'}, which defaults to \code{'par'} -- for \code{doParallel}. The backend can also be set on runtime via argument \code{.pbackend}. \medskip \paragraph{IMPORTANT NOTE:} The parallel computation is based on the \pkgname{doParallel} and \pkgname{parallel} packages, and the same care should be taken as stated in the vignette of the \citeCRANpkg{doMC}: \begin{quote} \emph{... it usually isn't safe to run doMC and multicore from a GUI environment. In particular, it is not safe to use doMC from R.app on Mac OS X. Instead, you should use doMC from a terminal session, starting R from the command line.} \end{quote} Therefore, the \code{nmf} function does not allow to run multicore computation from the MacOS X GUI. From version 0.8, other parallel backends are supported, and may be specified via argument \code{.pbackend}: \begin{description} \item[\code{.pbackend='mpi'}] uses the parallel backend \citeCRANpkg{doParallel} and \citeCRANpkg{doMPI} \item[\code{.pbackend=NULL}]{} \end{description} It is possible to specify that the currently registered backend should be used, by setting argument \code{.pbackend=NULL}. This allow to perform parallel computations with ``permanent'' backends that are configured externally of the \code{nmf} call. \subsubsection{Runtime options} There are two other runtime options, \code{parallel} and \code{parallel.required}, that can be passed via argument \code{.options}, to control the behaviour of the parallel computation (see below). \medskip A call for multiple runs will be computed in parallel if one of the following condition is satisfied: \begin{itemize} \item call with option \code{'P'} or \code{parallel.required} set to TRUE (note the upper case in \code{'P'}). In this case, if for any reason the computation cannot be run in parallel (packages requirements, OS, ...), then an error is thrown. Use this mode to force the parallel execution. \item call with option \code{'p'} or \code{parallel} set to TRUE. In this case if something prevents a parallel computation, the factorizations will be done sequentially. \item a valid parallel backend is specified in argument \code{.pbackend}. For the moment it can either be the string \code{'mc'} or a single \code{numeric} value specifying the number of core to use. Unless option \code{'P'} is specified, it will run using option \code{'p'} (i.e. try-parallel mode). \end{itemize} \nbnote{The number of processors to use can also be specified in the runtime options as e.g. \texttt{.options='p4'} or \texttt{.options='P4'} -- to ask or request 4 CPUs.} \paragraph{Examples}\ \\ The following exmaples are run with \code{.options='v'} which turn on verbosity at level 1, that will show which parallell setting is used by each computation. Although we do not show the output here, the user is recommended to run these commands on his machine to see the internal differences of each call. <>= # the default call will try to run in parallel using all the cores # => will be in parallel if all the requirements are satisfied nmf(esGolub, 3, nrun=5, .opt='v') # request a certain number of cores to use => no error if not possible nmf(esGolub, 3, nrun=5, .opt='vp8') # force parallel computation: use option 'P' nmf(esGolub, 3, nrun=5, .opt='vP') # require an improbable number of cores => error nmf(esGolub, 3, nrun=5, .opt='vP200') @ \subsubsection{High Performance Computing on a cluster} To achieve further speed-up, the computation can be run on an HPC cluster. In our tests we used the \citeCRANpkg{doMPI} to perform 100 factorizations using hybrid parallel computation on 4 quadri-core machines -- making use of all the cores computation on each machine. <>= # file: mpi.R ## 0. Create and register an MPI cluster library(doMPI) cl <- startMPIcluster() registerDoMPI(cl) library(NMF) # run on all workers using the current parallel backend data(esGolub) res <- nmf(esGolub, 3, 'brunet', nrun=n, .opt='p', .pbackend=NULL) # save result save(res, file='result.RData') ## 4. Shutdown the cluster and quit MPI closeCluster(cl) mpi.quit() @ Passing the following shell script to \emph{qsub} should launch the execution on a Sun Grid Engine HPC cluster, with OpenMPI. Some adaptation might be necessary for other queueing systems/installations. \begin{shaded} \small \begin{verbatim} #!/bin/bash #$ -cwd #$ -q opteron.q #$ -pe mpich_4cpu 16 echo "Got $NSLOTS slots. $TMP/machines" orterun -v -n $NSLOTS -hostfile $TMP/machines R --slave -f mpi.R \end{verbatim} \end{shaded} \subsubsection{Forcing sequential execution} When running on a single core machine, \nmfpack package has no other option than performing the multiple runs sequentially, one after another. This is done via the \code{sapply} function. On multi-core machine, one usually wants to perform the runs in parallel, as it speeds up the computation (cf. \cref{multicore}). However in some situation (e.g. while debugging), it might be useful to force the sequential execution of the runs. This can be done via the option \code{'p1'} to run on a single core , or with \code{.pbackend='seq'} to use the foreach backend \code{doSEQ} or to \code{NA} to use a standard \code{sapply} call: <>= # parallel execution on 2 cores (if possible) res1 <- nmf(esGolub, 3, nrun=5, .opt='vp2', seed=123) # or use the doParallel with single core res2 <- nmf(esGolub, 3, nrun=5, .opt='vp1', seed=123) # force sequential computation by sapply: use option '-p' or .pbackend=NA res3 <- nmf(esGolub, 3, nrun=5, .opt='v-p', seed=123) res4 <- nmf(esGolub, 3, nrun=5, .opt='v', .pbackend=NA, seed=123) # or use the SEQ backend of foreach: .pbackend='seq' res5 <- nmf(esGolub, 3, nrun=5, .opt='v', .pbackend='seq', seed=123) # all results are all identical nmf.equal(list(res1, res2, res3, res4, res5)) @ \subsection{Estimating the factorization rank} A critical parameter in NMF is the factorization rank $r$. It defines the number of metagenes used to approximate the target matrix. Given a NMF method and the target matrix, a common way of deciding on $r$ is to try different values, compute some quality measure of the results, and choose the best value according to this quality criteria. Several approaches have then been proposed to choose the optimal value of $r$. For example, \cite{Brunet2004} proposed to take the first value of $r$ for which the cophenetic coefficient starts decreasing, \cite{Hutchins2008} suggested to choose the first value where the RSS curve presents an inflection point, and \cite{Frigyesi2008} considered the smallest value at which the decrease in the RSS is lower than the decrease of the RSS obtained from random data. The \nmfpack package provides functions to help implement such procedures and plot the relevant quality measures. Note that this can be a lengthy computation, depending on the data size. Whereas the standard NMF procedure usually involves several hundreds of random initialization, performing 30-50 runs is considered sufficient to get a robust estimate of the factorization rank \cite{Brunet2004, Hutchins2008}. For performance reason, we perform here only 10 runs for each value of the rank. <>= # perform 10 runs for each value of r in range 2:6 estim.r <- nmf(esGolub, 2:6, nrun=10, seed=123456) @ The result is a S3 object of class \code{NMF.rank}, that contains a \code{data.frame} with the quality measures in column, and the values of $r$ in row. It also contains a list of the consensus matrix for each value of $r$. All the measures can be plotted at once with the method \code{plot} (\cref{fig:estim_all}), and the function \code{consensusmap} generates heatmaps of the consensus matrix for each value of the rank. In the context of class discovery, it is useful to see if the clusters obtained correspond to known classes. This is why in the particular case of the Golub dataset, we added annotation tracks for the two covariates available ('Cell' and 'ALL.AML'). Since we removed the variable 'Sample' in the preliminaries, these are the only variables in the phenotypic \code{data.frame} embedded within the \code{ExpressionSet} object, and we can simply pass the whole object to argument \code{annCol} (\cref{fig:estim_all_hm}). One can see that at rank 2, the clusters correspond to the ALL and AML samples respectively, while rank 3 separates AML from ALL/T-cell and ALL/B-cell\footnote{Remember that the plots shown in \cref{fig:estim_all_hm} come from only 10 runs, using the 200 first genes in the dataset, which explains the somewhat not so clean clusters. The results are in fact much cleaner when using the full dataset (\cref{fig:heatmap_consensus}).}. \begin{figure} <>= plot(estim.r) @ \caption{Estimation of the rank: Quality measures computed from 10 runs for each value of $r$. \label{fig:estim_all}} \end{figure} \begin{figure} <>= consensusmap(estim.r, annCol=esGolub, labCol=NA, labRow=NA) @ \caption{Estimation of the rank: Consensus matrices computed from 10 runs for each value of $r$. \label{fig:estim_all_hm}} \end{figure} \subsubsection{Overfitting} Even on random data, increasing the factorization rank would lead to decreasing residuals, as more variables are available to better fit the data. In other words, there is potentially an overfitting problem. In this context, the approach from \cite{Frigyesi2008} may be useful to prevent or detect overfitting as it takes into account the results for unstructured data. However it requires to compute the quality measure(s) for the random data. The \nmfpack package provides a function that shuffles the original data, by permuting the rows of each column, using each time a different permutation. The rank estimation procedure can then be applied to the randomized data, and the ``random'' measures added to the plot for comparison (\cref{fig:estim_all_rd}). \begin{figure} <>= # shuffle original data V.random <- randomize(esGolub) # estimate quality measures from the shuffled data (use default NMF algorithm) estim.r.random <- nmf(V.random, 2:6, nrun=10, seed=123456) # plot measures on same graph plot(estim.r, estim.r.random) @ \caption{Estimation of the rank: Comparison of the quality measures with those obtained from randomized data. The curves for the actual data are in blue and green, those for the randomized data are in red and pink. The estimation is based on Brunet's algorithm.} \label{fig:estim_all_rd} \end{figure} \subsection{Comparing algorithms} To compare the results from different algorithms, one can pass a list of methods in argument \code{method}. To enable a fair comparison, a deterministic seeding method should also be used. Here we fix the random seed to 123456. <>= # fit a model for several different methods res.multi.method <- nmf(esGolub, 3, list('brunet', 'lee', 'ns'), seed=123456, .options='t') @ Passing the result to method \code{compare} produces a \code{data.frame} that contains summary measures for each method. Again, prior knowledge of classes may be used to compute clustering quality measures: <>= compare(res.multi.method) # If prior knowledge of classes is available compare(res.multi.method, class=esGolub$Cell) @ Because the computation was performed with error tracking enabled, an error plot can be produced by method \code{plot} (\cref{fig:errorplot}). Each track is normalized so that its first value equals one, and stops at the iteration where the method's convergence criterion was fulfilled. \subsection{Visualization methods} \subsubsection*{Error track} If the NMF computation is performed with error tracking enabled -- using argument \code{.options} -- the trajectory of the objective value is computed during the fit. This computation is not enabled by default as it induces some overhead. <>= # run nmf with .option='t' res <- nmf(esGolub, 3, .options='t') # or with .options=list(track=TRUE) @ The trajectory can be plot with the method \code{plot} (\cref{fig:errorplot}): \begin{figure}[!htbp] <>= plot(res) plot(res.multi.method) @ \caption{Error track for a single NMF run (left) and multiple method runs (right)} \label{fig:errorplot} \end{figure} \subsubsection*{Heatmaps} The methods \code{basismap}, \code{coefmap} and \code{consensusmap} provide an easy way to visualize respectively the resulting basis matrix (i.e. metagenes), mixture coefficient matrix (i.e. metaprofiles) and the consensus matrix, in the case of multiple runs. It produces pre-configured heatmaps based on the function \code{aheatmap}, the underlying heatmap engine provided with the package NMF. The default heatmaps produced by these functions are shown in \cref{fig:heatmap_coef_basis,fig:heatmap_consensus}. They can be customized in many different ways (colours, annotations, labels). See the dedicated vignette \emph{``NMF: generating heatmaps"} or the help pages \code{?coefmap} and \code{?aheatmap} for more information. An important and unique feature of the function \code{aheatmap}, is that it makes it possible to combine several heatmaps on the same plot, using the both standard layout calls \texttt{par(mfrow=...)} and \texttt{layout(...)}, or grid viewports from \texttt{grid} graphics. The plotting context is automatically internally detected, and a correct behaviour is achieved thanks to the \citeCRANpkg{gridBase}. Examples are provided in the dedicated vignette mentioned above. The rows of the basis matrix often carry the high dimensionality of the data: genes, loci, pixels, features, etc\ldots The function \code{basismap} extends the use of argument \code{subsetRow} (from \code{aheatmap}) to the specification of a feature selection method. In \cref{fig:heatmap_coef_basis} we simply used \code{subsetRow=TRUE}, which subsets the rows using the method described in \cite{KimH2007}, to only keep the basis-specific features (e.g. the metagene-specific genes). We refer to the relevant help pages \code{?basismap} and \code{?aheatmap} for more details about other possible values for this argument. \begin{figure}[!htbp] \centering <>= layout(cbind(1,2)) # basis components basismap(res, subsetRow=TRUE) # mixture coefficients coefmap(res) @ \caption{Heatmap of the basis and the mixture coefficient matrices. The rows of the basis matrix were selected using the default feature selection method -- described in \cite{KimH2007}.} \label{fig:heatmap_coef_basis} \end{figure} In the case of multiple runs the function \code{consensusmap} plots the consensus matrix, i.e. the average connectivity matrix across the runs (see results in \cref{fig:heatmap_consensus} for a consensus matrix obtained with 100 runs of Brunet's algorithm on the complete Golub dataset): \begin{figure}[ht] <>= # The cell type is used to label rows and columns consensusmap(res.multirun, annCol=esGolub, tracks=NA) plot(1:10) f2 <- fig_path("2.pdf") @ <>= file.copy('consensus.pdf', f2, overwrite=TRUE) @ \caption{Heatmap of consensus matrices from 10 runs on the reduced dataset (left) and from 100 runs on the complete Golub dataset (right).} \label{fig:heatmap_consensus} \end{figure} \section{Extending the package} We developed the \nmfpack\ package with the objective to facilitate the integration of new NMF methods, trying to impose only few requirements on their implementations. All the built-in algorithms and seeding methods are implemented as strategies that are called from within the main interface method \code{nmf}. The user can define new strategies and those are handled in exactly the same way as the built-in ones, benefiting from the same utility functions to interpret the results and assess their performance. \subsection{Custom algorithm} %New NMF algrithms can be defined in two ways: % %\begin{itemize} %\item as a single \code{function} %\item as a set of functions that implement a pre-defined \emph{iterative schema} %\end{itemize} % %\subsubsection{Defined as a \code{function}} \subsubsection{Using a custom algorithm}\label{sec:algo_custom} To define a strategy, the user needs to provide a \code{function} that implements the complete algotihm. It must be of the form: <>= my.algorithm <- function(x, seed, param.1, param.2){ # do something with starting point # ... # return updated starting point return(seed) } @ Where: \begin{description} \item[target] is a \code{matrix}; \item[start] is an object that inherits from class \code{NMF}. This \code{S4} class is used to handle NMF models (matrices \code{W} and \code{H}, objective function, etc\dots); \item[param.1, param.2] are extra parameters specific to the algorithms; \end{description} The function must return an object that inherits from class \code{NMF}. For example: <>= my.algorithm <- function(x, seed, scale.factor=1){ # do something with starting point # ... # for example: # 1. compute principal components pca <- prcomp(t(x), retx=TRUE) # 2. use the absolute values of the first PCs for the metagenes # Note: the factorization rank is stored in object 'start' factorization.rank <- nbasis(seed) basis(seed) <- abs(pca$rotation[,1:factorization.rank]) # use the rotated matrix to get the mixture coefficient # use a scaling factor (just to illustrate the use of extra parameters) coef(seed) <- t(abs(pca$x[,1:factorization.rank])) / scale.factor # return updated data return(seed) } @ To use the new method within the package framework, one pass \code{my.algorithm} to main interface \code{nmf} via argument \code{method}. Here we apply the algorithm to some matrix \code{V} randomly generated: <>= n <- 50; r <- 3; p <- 20 V <-syntheticNMF(n, r, p) @ <>= nmf(V, 3, my.algorithm, scale.factor=10) @ \subsubsection{Using a custom distance measure} The default distance measure is based on the euclidean distance. If the algorithm is based on another distance measure, this one can be specified in argument \code{objective}, either as a \code{character} string corresponding to a built-in objective function, or a custom \code{function} definition\footnote{Note that from version 0.8, the arguments for custom objective functions have been swapped: (1) the current NMF model, (2) the target matrix}: <>= # based on Kullback-Leibler divergence nmf(V, 3, my.algorithm, scale.factor=10, objective='KL') # based on custom distance metric nmf(V, 3, my.algorithm, scale.factor=10 , objective=function(model, target, ...){ ( sum( (target-fitted(model))^4 ) )^{1/4} } ) @ %\subsubsection{Using the iterative schema} % %NMF algorithms generally implement the following common iterative schema: % %\begin{enumerate} %\item %\item %\end{enumerate} \subsubsection{Defining algorithms for mixed sign data} All the algorithms implemented in the \nmfpack package assume that the input data is nonnegative. However, some methods exist in the litterature that work with relaxed constraints, where the input data and one of the matrix factors ($W$ or $H$) are allowed to have negative entries (eg. semi-NMF \cite{Ding2010, Roux2008}). Strictly speaking these methods do not fall into the NMF category, but still solve constrained matrix factorization problems, and could be considered as NMF methods when applied to non-negative data. Moreover, we received user requests to enable the development of semi-NMF type methods within the package's framework. Therefore, we designed the \nmfpack package so that such algorithms -- that handle negative data -- can be integrated. This section documents how to do it. By default, as a safe-guard, the sign of the input data is checked before running any method, so that the \code{nmf} function throws an error if applied to data that contain negative entries \footnote{Note that on the other side, the sign of the factors returned by the algorithms is never checked, so that one can always return factors with negative entries.}. To extend the capabilities of the \nmfpack package in handling negative data, and plug mixed sign NMF methods into the framework, the user needs to specify the argument \code{mixed=TRUE} in the call to the \code{nmf} function. This will skip the sign check of the input data and let the custom algorithm perform the factorization. As an example, we reuse the previously defined custom algorithm\footnote{As it is defined here, the custom algorithm still returns nonnegative factors, which would not be desirable in a real example, as one would not be able to closely fit the negative entries.}: <>= # put some negative input data V.neg <- V; V.neg[1,] <- -1; # this generates an error try( nmf(V.neg, 3, my.algorithm, scale.factor=10) ) # this runs my.algorithm without error nmf(V.neg, 3, my.algorithm, mixed=TRUE, scale.factor=10) @ \subsubsection{Specifying the NMF model} If not specified in the call, the NMF model that is used is the standard one, as defined in \cref{NMFstd}. However, some NMF algorithms have different underlying models, such as non-smooth NMF \cite{Pascual-Montano2006} which uses an extra matrix factor that introduces an extra parameter, and change the way the target matrix is approximated. The NMF models are defined as S4 classes that extends class \code{NMF}. All the available models can be retreived calling the \code{nmfModel()} function with no argument: <>= nmfModel() @ One can specify the NMF model to use with a custom algorithm, using argument \code{model}. Here we first adapt a bit the custom algorithm, to justify and illustrate the use of a different model. We use model \code{NMFOffset} \cite{Badea2008}, that includes an offset to take into account genes that have constant expression levels accross the samples: <>= my.algorithm.offset <- function(x, seed, scale.factor=1){ # do something with starting point # ... # for example: # 1. compute principal components pca <- prcomp(t(x), retx=TRUE) # retrieve the model being estimated data.model <- fit(seed) # 2. use the absolute values of the first PCs for the metagenes # Note: the factorization rank is stored in object 'start' factorization.rank <- nbasis(data.model) basis(data.model) <- abs(pca$rotation[,1:factorization.rank]) # use the rotated matrix to get the mixture coefficient # use a scaling factor (just to illustrate the use of extra parameters) coef(data.model) <- t(abs(pca$x[,1:factorization.rank])) / scale.factor # 3. Compute the offset as the mean expression data.model@offset <- rowMeans(x) # return updated data fit(seed) <- data.model seed } @ Then run the algorithm specifying it needs model \code{NMFOffset}: <>= # run custom algorithm with NMF model with offset nmf(V, 3, my.algorithm.offset, model='NMFOffset', scale.factor=10) @ \subsection{Custom seeding method}\label{sec:seed_custom} The user can also define custom seeding method as a function of the form: <>= # start: object of class NMF # target: the target matrix my.seeding.method <- function(model, target){ # use only the largest columns for W w.cols <- apply(target, 2, function(x) sqrt(sum(x^2))) basis(model) <- target[,order(w.cols)[1:nbasis(model)]] # initialize H randomly coef(model) <- matrix(runif(nbasis(model)*ncol(target)) , nbasis(model), ncol(target)) # return updated object return(model) } @ To use the new seeding method: <>= nmf(V, 3, 'snmf/r', seed=my.seeding.method) @ \section{Advanced usage} \subsection{Package specific options} The package specific options can be retieved or changed using the \code{nmf.getOption} and \code{nmf.options} functions. These behave similarly as the \code{getOption} and \code{nmf.options} base functions: <>= #show default algorithm and seeding method nmf.options('default.algorithm', 'default.seed') # retrieve a single option nmf.getOption('default.seed') # All options nmf.options() @ Currently the following options are available: <>= RdSection2latex('nmf.options', package='NMF') @ The default/current values of each options can be displayed using the function \code{nmf.printOptions}: <>= nmf.printOptions() @ %% latex table generated in R 2.10.1 by xtable 1.5-6 package %% Wed Apr 7 15:27:05 2010 %\begin{table}[ht] %\begin{center} %\begin{tabularx}{\textwidth}{>{\ttfamily}rlX} % \hline %Option & Default value & Description\\ %\hline %default.algorithm & brunet & Default NMF algorithm used by the \code{nmf} function when argument \code{method} is missing. %The value should the key of one of the available NMF algorithms. %See \code{?nmfAlgorithm}.\\ %track.interval & 30 & Number of iterations between two points in the residual track. %This option is relevant only when residual tracking is enabled. %See \code{?nmf}.\\ %error.track & FALSE & Toggle default residual tracking. %When \code{TRUE}, the \code{nmf} function compute and store the residual track in the result -- if not otherwise specified in argument \code{.options}. %Note that tracking may significantly slow down the computations.\\ %default.seed & random & Default seeding method used by the \code{nmf} function when argument \code{seed} is missing. %The value should the key of one of the available seeding methods. %See \code{?nmfSeed}.\\ %backend & mc & Default parallel backend used used by the \code{nmf} function when argument \code{.pbackend} is missing. %Currently the following values are supported: \code{'mc'} for multicore, \code{'seq'} for sequential, \code{''} for \code{sapply}.\\ %verbose & FALSE & Toggle verbosity.\\ %debug & FALSE & Toggle debug mode, which is an extended verbose mode.\\ %\hline %\end{tabularx} %\end{center} %\caption{} %\end{table} \pagebreak \section{Session Info} <>= toLatex(sessionInfo()) @ \printbibliography[heading=bibintoc] \end{document} NMF/README.md0000644000176000001440000000432612307621211012201 0ustar ripleyusers## Background Nonnegative Matrix Factorization (NMF) is an unsupervised learning technique that has been applied successfully in several fields, including signal processing, face recognition and text mining. Recent applications of NMF in bioinformatics have demonstrated its ability to extract meaningful information from high-dimensional data such as gene expression microarrays. Developments in NMF theory and applications have resulted in a variety of algorithms and methods. However, most NMF implementations have been on commercial platforms, while those that are freely available typically require programming skills. This limits their use by the wider research community. ## Results Our objective is to provide the bioinformatics community with an open-source, easy-to-use and unified interface to standard NMF algorithms, as well as with a simple framework to help implement and test new NMF methods. For that purpose, we have developed a package for the R/BioConductor platform. The package ports public code to R, and is structured to enable users to easily modify and/or add algorithms. It includes a number of published NMF algorithms and initialization methods and facilitates the combination of these to produce new NMF strategies. Commonly used benchmark data and visualization methods are provided to help in the comparison and interpretation of the results. ## Conclusions The NMF package helps realize the potential of Nonnegative Matrix Factorization, especially in bioinformatics, providing easy access to methods that have already yielded new insights in many applications. ## Availability Documentation, source code and sample data are available from: * ![](img/r-icon.jpg) Latest stable release from CRAN: http://cran.r-project.org/package=NMF * Development versions: * ![](img/r-forge-icon.png) project: http://r-forge.r-project.org/projects/nmf
_NOTE: due to some unknown problem on R-forge build system, the package is not being built. Please use the MyCRAN repository until the issue is fixed._

* MyCRAN: personal CRAN-like repository at http://web.cbio.uct.ac.za/~renaud/CRAN ----- __Travis check:__ [![Build Status](https://travis-ci.org/renozao/NMF.png?branch=devel)](https://travis-ci.org/renozao/NMF) NMF/MD50000644000176000001440000003017712531007322011235 0ustar ripleyusers9b3d758eef59f0fa3d3934f7012d8ae3 *DESCRIPTION dc463bcaef88f72ce59f851dcea117db *NAMESPACE 192be80e51d0299e5f0e915bb8f1a19e *NEWS 04f33b56f5ccb3f8668c07e3d9aaa7c3 *R/Bioc-layer.R 67be79625bdfdd06e76bb2787a9f436d *R/NMF-class.R cb92fbe2ad8ed07d3b6988790361cf89 *R/NMFOffset-class.R 56c06d6a59b72229d6fed8139b5917e1 *R/NMFSeed-class.R a6e1c940afa9605ea59dd22fdedb30d7 *R/NMFSet-class.R 4d669da42d6a80c8935da68991d5cfec *R/NMFStrategy-class.R 7c005d6fc277f6c4f194b3be145e9e11 *R/NMFStrategyFunction-class.R 952c6d74fe3200647696bd1755707cf8 *R/NMFStrategyIterative-class.R 9057be72901f4081ffd36dff90064e0c *R/NMFStrategyOctave-class.R 9bfd9b9a7f095d2d23aad3192c7dad93 *R/NMFfit-class.R d4a9ccb2a64df0fcc003732b22087b29 *R/NMFns-class.R 43617bc2d80d2df2fa79aac76e6877f4 *R/NMFplots.R 06ce7f9fb62284b85f8faea26cd9bc08 *R/NMFstd-class.R b93c44a16dcada0f9afbdabd898c0294 *R/aheatmap.R 2215efb3fafbbae155830aed6b0b3ae1 *R/algorithmic.R 5c93753b2b401fd5b8c80b592f93193d *R/algorithms-base.R bc346e375c98c41a03c3ae745b5dbdf9 *R/algorithms-brunet.R 015a5cef7738322d66ae1f280225f9e6 *R/algorithms-lnmf.R 6600c764faf7481013e0d6481fc25151 *R/algorithms-lsnmf.R ff9c9ac7006e8ef914ddb1d883316cbb *R/algorithms-pe-nmf.R c7345e2125689ff69487338672fead40 *R/algorithms-siNMF.R 512da544843f613eeb487c24e73095ce *R/algorithms-snmf.R eca172be180d1e51dec38a7aaab54bee *R/atracks.R 04c8a4c2f078a8327a068943eef561d6 *R/colorcode.R 7872d34875136dc2b2e8c1875ce2caa7 *R/data.R d5c1883b5350a8285e19c2772ceb50d8 *R/extractFeatures.R ec3cfef0d083ed95661a6c57bd61e660 *R/fixed-terms.R 1f90bca8a7b53737476d0956b55502ab *R/grid.R 5cf50ed45523796cab2a7a9533fd6981 *R/heatmaps.R 8ae4dc88757079df32de4d541247444c *R/nmf-package.R 8cb380f3596ae6bd5f7bd26cfc6dbbdf *R/nmf.R b0ef416f59a1be65a4409b9af8d4b9e0 *R/nmfModel.R b775850b0cf2d25c9d4f674298030b3a *R/options.R 4888147bee54949ca191fa91cb17d668 *R/parallel.R 8ea29d577c7c4e8f8b4dc34ba4421da4 *R/registry-algorithms.R bd61f889b0bb039c703a7de9898e5fbc *R/registry-seed.R 66ca4afe8515dedd71d07dc05bbcc4d7 *R/registry.R c28c1144175993becd60f5a16156a3e2 *R/rmatrix.R b1d44e778d211021bc1754e90551c7c5 *R/rnmf.R 373909c677f0e1db2301f30638145a13 *R/run.R dd767a7d1fde7adfe30b3fee7cf86f5b *R/seed-base.R 1fcf1d8cb6162329731c7dd6d02c8a97 *R/seed-ica.R 5ae81c6a61fc0e16090acde2f16da5d4 *R/seed-nndsvd.R 71bf9f5ea7e161d5b3604040e37785ad *R/setNMFClass.R 5017945c10bf9b95560568b58c90559a *R/simulation.R 610b78f4f8f21a5a85d97967e4577bc8 *R/tests.R 4d204e4cda9cdcb86f26bc220e0c3408 *R/transforms.R ce8005200ba770a584eab5ae7f703bb9 *R/utils.R 77bc2b9255b6a8b6044e67e08ec91284 *R/versions.R ca5b072a375cfc90d9a1b8530a2159dc *README.md 551e2ca0a05eff9062c105483449fac4 *TODO 7ce651165cacaa2ee6b9dc93f0238d35 *build/vignette.rds f8015e2bc710fb0bf869d2fdddf90e73 *data/esGolub.rda 7ee636d67aaf85d2b38c87f512559c1d *demo/00Index 5d230c7b9bd8450e8f3621f0fa2e8fe9 *demo/aheatmap.R 1772a84edd497138e1c2026608d99348 *demo/heatmaps.R 51502b8ceeab50a22383047790cc5ab6 *demo/nmf.R 64e0559e3860021948647aaa5f831499 *inst/CITATION c4d05e519580e330b6c7693b18650773 *inst/REFERENCES.bib b8685571f46f595488cf8a6811e5a748 *inst/doc/NMF-unitTests.R 888e8d888eefa87589a5d1846a1b4dea *inst/doc/NMF-unitTests.Rnw 4721c186b35c1cb974b8a57aa56e02c5 *inst/doc/NMF-unitTests.pdf 11cdd75b60fc3577bf8e22c73c717cf1 *inst/doc/NMF-vignette.R d3a631ff66077530b722b7c779263367 *inst/doc/NMF-vignette.Rnw c8ca9dd04271005e6e8253264380d26b *inst/doc/NMF-vignette.pdf 490308526e45334c1526083977dce954 *inst/doc/consensus.pdf 5a53da6ca7bf0ae84bae0e8e4ff5984b *inst/doc/heatmaps.R 117e593dae265395cc28634365848af2 *inst/doc/heatmaps.Rnw fb507f8eb6151f14de9b14a629c5d483 *inst/doc/heatmaps.pdf 8228eb196a5735d46af06c261500aa04 *inst/m-files/brunet-run.m 7b784dfee92d29634fe40f0270a01946 *inst/m-files/brunet.R aa0bc4166c0c05507a5fb0a85d3c16a8 *inst/m-files/brunet.m 21a62ee5e50af50c0b22f88d167d068c *inst/scripts/grid.R 2952972c46324b0beb29d6892b7e2e40 *inst/scripts/report.Rmd ede84a7c14827aaf8388753d3782649b *inst/tests/runit.NMFSet.r 185a0cc2211506feff114fa1f7720e1f *inst/tests/runit.NMFStrategy-class.r 73ca1b2198fc6359c11cb0e247047bfc *inst/tests/runit.NMFclass.r ba38b9bbe7cb50d383f2f9fb021a6d82 *inst/tests/runit.NMFfit-class.r c2fe5109fe6867bec03df76785b4a143 *inst/tests/runit.aheatmap.R 69fb12d4a21c13d82b43f472d60adb5f *inst/tests/runit.algorithms.r d989ecfa90aef8cc16a84520fb3763f4 *inst/tests/runit.bioc.r f252a885bbb0046bd55e59fbd511888b *inst/tests/runit.distance.r 3ac992c6681a6d2f7b014904db460648 *inst/tests/runit.interface.r 59b288c96a3b2803f83d5a46c0d0b688 *inst/tests/runit.options.r 03df1801f20a8612f71db7cb65772c55 *inst/tests/runit.parallel.r a628ceb384967f4f6575999bc1bc6b07 *inst/tests/runit.seed.r 4fc04c7ba5d73eb1b804a9d25c436a3f *inst/tests/runit.utils.r 767832f7e470c4704f4b7602d23a7798 *man/Frobenius-nmf.Rd 63e0ab27b3b800565fa15751c0a46301 *man/KL-nmf.Rd d60a89e51d4ba938cb32ad04a2b07b85 *man/NMF-class.Rd 3afb15f1474a46e4086d736a3c871caf *man/NMF-defunct.Rd dc30d7f32eb6954c2e9aa946f8b9df26 *man/NMF-deprecated.Rd 116f36bf4cbaa1765e2fbe3c83862b58 *man/NMF-package.Rd 06d347a23a138dccfd978daa81ea0e1b *man/NMFList-class.Rd 201bfce1ddf5c18da7ac1bfe67ffb94f *man/NMFOffset-class.Rd 425940f01b128ed86c081405ae146ab0 *man/NMFSeed-class.Rd 895c97e9785c890a0181e953407ad117 *man/NMFStrategy-class.Rd 78a5599bceeaad4bfce2d04ce03c8a21 *man/NMFStrategy.Rd 5c94b9595c875433cb19171da1a62758 *man/NMFStrategyFunction-class.Rd 18cd07fb2cccaa6d2600fefe5c47b7a9 *man/NMFStrategyIterative-class.Rd d961a29bd12aeeb4f39e476040e1a795 *man/NMFStrategyOctave-class.Rd 3092af863a3f6a9b76f3f2f6fe769335 *man/NMFfit-class.Rd 83e8b4200bb4ae294f0ded0ae6d6e70c *man/NMFfitX-class.Rd d9a31d45444d62f906d662fc8b265426 *man/NMFfitX.Rd 634317c04783c19ed9ac96e8ad80ebba *man/NMFfitX1-class.Rd 9d50da90ee74c75a432a7cd900578c0f *man/NMFfitXn-class.Rd f874ba9928c02022df7d9c8a2ac5bd4d *man/NMFns-class.Rd 0af573b61066884e29f8152d8295575b *man/NMFstd-class.Rd 96b321036e3c998e4e52ee730e5884c5 *man/RNG.Rd 8b66c7ab49c34b0e5df0c652d45d437f *man/SNMF-nmf.Rd 42afa8e2c6f5d7ac5c045174a05bf8d5 *man/Strategy-class.Rd 28877eb83332222d0a67473a16148fbc *man/advanced.Rd 7765d6e9380a12d8f5c6a0d838c3c41e *man/aheatmap.Rd 762c9a6fd51a723065df7becaa801083 *man/algorithm-commaNMFList-method.Rd 23b560ee5c0e22253100cd1f8effe26b *man/algorithm-commaNMFStrategyOctave-method.Rd 54d030b5f5822647ddfdb8e731b91afe *man/algorithmic.Rd 9c3697730dd0a7aea87f13af6f726812 *man/assess.Rd 20413d9a4e878340f471a26415386685 *man/atrack.Rd a4855c2e0d6ece887e5e6b7fb27d640c *man/basis-coef-methods.Rd 435ac6f77719a0d9a5a18994c40989c1 *man/basiscor.Rd 1810d6750bc88981b602808d9f673c4a *man/bioc.Rd 182672f1ed5b39098c5127c0d1b96a8f *man/c-commaNMF-method.Rd 84c5ff2ee4546200a404c1968c7e4bd6 *man/canFit.Rd 4a680134ba34c9d60f7cf8448de0175c *man/ccBreaks.Rd 04aa500814501e01f971a9a9e649f7d6 *man/ccPalette.Rd 30b38d0eb549f60d498fea802752f9e8 *man/ccRamp.Rd ead0bcb1b2960042e6c225abaf312d3f *man/ccSpec.Rd 3c3630400842a8205c1698dd2ece18b9 *man/checkErrors.Rd 94b8ec67220a6c9cb58bf5a9d07c21ce *man/cluster_mat.Rd 491d24b685f65bb7aaafb80c3bcf908e *man/connectivity.Rd 079f0bf31cd00add0215f852c2671793 *man/consensus-commaNMFfitX1-method.Rd 4191760c707e50acc9085b946e6972e4 *man/consensus-commaNMFfitXn-method.Rd 1adf8241b895a1da992f6fd39b394d60 *man/consensushc.Rd 00357312e2fb0196a0c380f4134d2f32 *man/cophcor.Rd 656b6a8bfe95f66aa37d808b14427b72 *man/cutdendro.Rd 18de62f7c36df3b79d39e649b5f126c4 *man/deviance.Rd 4d758173653d9a9e4fc6826f10288896 *man/dimnames.Rd d17124d62761eea2293f997a41b3b978 *man/dims.Rd 0eda8c23e3906c11c2894eee60b12e26 *man/dispersion.Rd edcc1d52a2ad50aad945d5d74e65121a *man/dot-fcnnls.Rd 6a8e20c9e88cc67efb77568d963ed321 *man/esGolub.Rd 1913aebfe0827011d600e56f33587399 *man/fcnnls.Rd 26389df3557196423682198ca30e4490 *man/fit.Rd c1baa89aba303ba8bd4ef407e184e55c *man/fitted.Rd 06890b1489d4114507541c63b32ec5ed *man/foreach.Rd 4bdd231e0439efdac037a437ebd0fdd9 *man/gfile.Rd fedca5f307d98d0e1f276cf0595e6673 *man/grid.Rd 704aa7a66e9f87d1932a070f113df16f *man/heatmaps.Rd c103f3feaa7e2c4ddb4b5cb2de75356d *man/inplace.Rd 42c4702adb4bd8432e51b7f0d2aab9be *man/lsNMF-nmf.Rd ad4bea9f6bf8da8c5b8af058d4e70581 *man/lverbose.Rd 83ccd902c78857036785b022791144a5 *man/match_atrack.Rd 17146cceec053543e3ad16d0570d092d *man/nmf-compare.Rd eaf6a741f1e1f5e39d456414a391b249 *man/nmf.Rd b5a35acf90da3f5d014c3686d234368d *man/nmf.equal.Rd 625896d5746034a531a4d1da377fcb5f *man/nmfAlgorithm.Rd f9cb9d24d68ee319e7593c1d2fee3223 *man/nmfApply.Rd 0ad0ee7ca0345c8bb2ab226df30a1860 *man/nmfCheck.Rd 4952f5420fac8de51c8810e64b845974 *man/nmfEstimateRank.Rd d95047f4bf61f4c7ccaa1e921ba4b522 *man/nmfFormals.Rd 01cf1a46a5f53333fcb88f697040aa64 *man/nmfModel.Rd d4898d6e3b1cd1b6b178a60c2d576ee5 *man/nmfObject.Rd 49f4c64242cc5d0c47b94a9c42807ca2 *man/nmfReport.Rd fce06c76bfd398abc1a348d67e7e8c58 *man/nmfSeed.Rd 7780fe2dae233c6ba52e340d797e2a11 *man/nmfWrapper.Rd 48346311c56811ab4bfc502a46feac77 *man/nmf_update_KL.Rd 01282dba5a9467f5c34e9d7b2d405ded *man/nmf_update_euclidean.Rd c28f918be30a5da8db623facf38eea9f *man/nneg.Rd f481c5f6107309c849530b83206f18f2 *man/nsNMF-nmf.Rd ca58350f90998275f533e264d5ce5942 *man/objective-commaNMFfit-method.Rd 4082dd89c61fd2ae75e274171565642b *man/offset-commaNMFOffset-method.Rd c5c14f3e24e71b81dc726a027234fd77 *man/offset-commaNMFfit-method.Rd 00d3fe2de32a02827359c85f3b2838fe *man/offset-nmf.Rd b948e9807bd7e64baab6a364285014d4 *man/options.Rd 58a943ee17a5986367c921175a200923 *man/parallel.Rd 1b26866d20f593b9a4d791975d0768f2 *man/parse_formula.Rd 2959063b2e6978de03a0bf0d3b314046 *man/plot-commaNMFfit-commamissing-method.Rd 6e450dcc8156f699b0e5d63c598a89d8 *man/predict.Rd 1f31e742a28febed67c816936f541345 *man/profplot.Rd d8d2498c4b415b41cde4cf9e8049f8a5 *man/purity.Rd 35694f86b6139a3ee2cd3f82a41ad824 *man/randomize.Rd 3560f009b84aa4bf1d3dfcbc1ecb1e16 *man/registry-algorithm.Rd cb7ba12690237f166574749bb707d3f7 *man/residuals.Rd c8aa1d388b52049207fc058e157af5b6 *man/revPalette.Rd 622964f68f0911dff7cf9eede6fac98e *man/rmatrix.Rd 5200979607c31ee9e75d2e4f2e89a37c *man/rnmf.Rd 08b1b09c30f90240167a25a5dc1671ef *man/rss.Rd e589f075ac5a2404fe136375475ab67c *man/runtime-commaNMFList-method.Rd 67dd23b7d9dd5739289857be80513bbc *man/runtime.all-commaNMFfitXn-method.Rd b20c67b061270a8948c14f30c029d266 *man/scale.NMF.Rd 0e9aa7fe953cbc4d0b2cdfdd6a61fabb *man/scores.Rd b1deacdafd60ed14a2ee40ec5dbffba3 *man/seed.Rd 0a372ae7c4ebd520f9a087253bf5f5cc *man/setNMFMethod.Rd 90119b84cf9e8a6c4d6faeb60d0c6cd9 *man/setNMFSeed.Rd 571ad68968801bbafe7f2d2e25a22550 *man/setup.Rd 7bb22e6720734f511e803a871fb26e39 *man/show-commaNMF-method.Rd 2d06782ea4c4ad91ac5694f33575e923 *man/show-commaNMFList-method.Rd 13c4118576e5e6767234d6b61f4d9159 *man/show-commaNMFOffset-method.Rd bb3a39862b068259cab8ea954454bcc2 *man/show-commaNMFSeed-method.Rd 84b6af7f192d8e0919bf6a7795645353 *man/show-commaNMFStrategyIterative-method.Rd 515b08c8a685e823723afeb4a1a313c8 *man/show-commaNMFfit-method.Rd f36b652373f4f16f2bb6828c2b5d585f *man/show-commaNMFfitX-method.Rd c1c89600aba522e34a6ba28190f2bd7c *man/show-commaNMFfitX1-method.Rd f14bfc191bb4d6d39684d9ee54a39736 *man/show-commaNMFfitXn-method.Rd becd00d7a3051215763271cd1eb8325e *man/show-commaNMFns-method.Rd 08716df0024ce0ca8f6a3a6f1ce8f599 *man/silhouette.NMF.Rd 9e8cf1622e25fed14b84bfcd0521ed35 *man/smoothing.Rd e6a7d35fb160e28931b03173e82cde35 *man/sparseness.Rd 127c40883b9775f0c9a8500378c0efed *man/staticVar.Rd b60bd8e815ca75ea07f7bcec5e2b4d3e *man/stop-NMF.Rd ae4a92d9c449e96cf2f7578d778b4beb *man/subset-NMF.Rd c8cf5183b055fd8a2b16c1d27f65f101 *man/syntheticNMF.Rd 4264ddc5ceb09fc3e2edf67a4ffea81e *man/t.NMF.Rd d0a67df32409d5fe6c871f24b2b71c7c *man/terms-internal.Rd b279c6ba4bf77ce4028e6e99ee3b6fb3 *man/terms.Rd 8af3bdb9baf9ace2bff7cf278528808e *man/txtProgressBar.Rd 7869fe34a7817d5f7aacb29c8b5bb7e7 *man/types.Rd c1dd149f5e75b70b800565157584fe7a *man/utils.Rd 7cc4426f76a914383e70b17f2f35c312 *src/distance.cpp 74facf85e6495aea68dd04b725cc6787 *src/divergence.cpp e78941582fb2d47fd1f87f9a48a37729 *src/euclidean.cpp 0678d1eb5e2c82c47e9a296fee622380 *src/utils.cpp 75c01c40d5204e71e378b8c27c963959 *tests/doRUnit.R 888e8d888eefa87589a5d1846a1b4dea *vignettes/NMF-unitTests.Rnw d3a631ff66077530b722b7c779263367 *vignettes/NMF-vignette.Rnw e80ff821d37969bdb7ff73081b8f7c53 *vignettes/consensus.pdf 117e593dae265395cc28634365848af2 *vignettes/heatmaps.Rnw c281ae2285729d8ddfb72a1dd198b148 *vignettes/src/bmc.R NMF/build/0000755000176000001440000000000012311534443012021 5ustar ripleyusersNMF/build/vignette.rds0000644000176000001440000000054312530712567014372 0ustar ripleyusersSMO@](p.?H!nP6vp+NehQ^TENMF/DESCRIPTION0000644000176000001440000000436712531007322012435 0ustar ripleyusersPackage: NMF Type: Package Title: Algorithms and Framework for Nonnegative Matrix Factorization (NMF) Version: 0.20.6 Date: 2015-05-25 Author: Renaud Gaujoux, Cathal Seoighe Maintainer: Renaud Gaujoux Description: Provides a framework to perform Non-negative Matrix Factorization (NMF). The package implements a set of already published algorithms and seeding methods, and provides a framework to test, develop and plug new/custom algorithms. Most of the built-in algorithms have been optimized in C++, and the main interface function provides an easy way of performing parallel computations on multicore machines. License: GPL (>= 2) URL: http://renozao.github.io/NMF BugReports: http://github.com/renozao/NMF/issues SCM: github:renozao, r-forge LazyLoad: yes VignetteBuilder: knitr Depends: R (>= 3.0.0), methods, utils, pkgmaker (>= 0.20), registry, rngtools (>= 1.2.3), cluster Imports: graphics, stats, stringr (>= 1.0.0), digest, grid, grDevices, gridBase, colorspace, RColorBrewer, foreach, doParallel, ggplot2, reshape2 Suggests: RcppOctave (>= 0.11), fastICA, doMPI, bigmemory (>= 4.2), synchronicity, corpcor, xtable, devtools, knitr, bibtex, RUnit, mail, Biobase Collate: 'rmatrix.R' 'nmf-package.R' 'utils.R' 'versions.R' 'algorithmic.R' 'options.R' 'grid.R' 'colorcode.R' 'atracks.R' 'aheatmap.R' 'NMF-class.R' 'transforms.R' 'Bioc-layer.R' 'NMFstd-class.R' 'NMFOffset-class.R' 'registry.R' 'heatmaps.R' 'NMFns-class.R' 'nmfModel.R' 'fixed-terms.R' 'NMFfit-class.R' 'NMFSet-class.R' 'NMFStrategy-class.R' 'NMFSeed-class.R' 'NMFStrategyFunction-class.R' 'NMFStrategyIterative-class.R' 'NMFStrategyOctave-class.R' 'NMFplots.R' 'registry-algorithms.R' 'algorithms-base.R' 'algorithms-brunet.R' 'algorithms-lnmf.R' 'algorithms-lsnmf.R' 'algorithms-pe-nmf.R' 'algorithms-siNMF.R' 'algorithms-snmf.R' 'data.R' 'extractFeatures.R' 'registry-seed.R' 'parallel.R' 'nmf.R' 'rnmf.R' 'run.R' 'seed-base.R' 'seed-ica.R' 'seed-nndsvd.R' 'setNMFClass.R' 'simulation.R' 'tests.R' Packaged: 2015-05-25 21:34:47 UTC; renaud NeedsCompilation: yes Repository: CRAN Date/Publication: 2015-05-26 08:12:33 NMF/man/0000755000176000001440000000000012307621244011476 5ustar ripleyusersNMF/man/smoothing.Rd0000644000176000001440000000172112305630424013773 0ustar ripleyusers\name{smoothing} \alias{smoothing} \title{Smoothing Matrix in Nonsmooth NMF Models} \usage{ smoothing(x, theta = x@theta, ...) } \arguments{ \item{x}{a object of class \code{NMFns}.} \item{theta}{the smoothing parameter (numeric) between 0 and 1.} \item{...}{extra arguments to allow extension (not used)} } \value{ if \code{x} estimates a \eqn{r}-rank NMF, then the result is a \eqn{r \times r} square matrix. } \description{ The function \code{smoothing} builds a smoothing matrix for using in Nonsmooth NMF models. } \details{ For a \eqn{r}-rank NMF, the smoothing matrix of parameter \eqn{\theta} is built as follows: \deqn{S = (1-\theta)I + \frac{\theta}{r} 11^T ,} where \eqn{I} is the identity matrix and \eqn{1} is a vector of ones (cf. \code{\link{NMFns-class}} for more details). } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } x <- nmfModel(3, model='NMFns') smoothing(x) smoothing(x, 0.1) } NMF/man/offset-nmf.Rd0000644000176000001440000001221212305630424014025 0ustar ripleyusers\name{nmf_update.euclidean_offset.h} \alias{nmfAlgorithm.offset} \alias{nmfAlgorithm.offset_R} \alias{nmf_update.euclidean_offset.h} \alias{nmf_update.euclidean_offset.w} \alias{nmf_update.offset} \alias{nmf_update.offset_R} \alias{offset_R-nmf} \title{NMF Multiplicative Update for NMF with Offset Models} \usage{ nmf_update.euclidean_offset.h(v, w, h, offset, eps = 10^-9, copy = TRUE) nmf_update.euclidean_offset.w(v, w, h, offset, eps = 10^-9, copy = TRUE) nmf_update.offset_R(i, v, x, eps = 10^-9, ...) nmf_update.offset(i, v, x, copy = FALSE, eps = 10^-9, ...) nmfAlgorithm.offset_R(..., .stop = NULL, maxIter = nmf.getOption("maxIter") \%||\% 2000, eps = 10^-9, stopconv = 40, check.interval = 10) nmfAlgorithm.offset(..., .stop = NULL, maxIter = nmf.getOption("maxIter") \%||\% 2000, copy = FALSE, eps = 10^-9, stopconv = 40, check.interval = 10) } \arguments{ \item{offset}{current value of the offset/intercept vector. It must be of length equal to the number of rows in the target matrix.} \item{v}{target matrix.} \item{eps}{small numeric value used to ensure numeric stability, by shifting up entries from zero to this fixed value.} \item{copy}{logical that indicates if the update should be made on the original matrix directly (\code{FALSE}) or on a copy (\code{TRUE} - default). With \code{copy=FALSE} the memory footprint is very small, and some speed-up may be achieved in the case of big matrices. However, greater care should be taken due the side effect. We recommend that only experienced users use \code{copy=TRUE}.} \item{i}{current iteration number.} \item{x}{current NMF model, as an \code{\linkS4class{NMF}} object.} \item{...}{extra arguments. These are generally not used and present only to allow other arguments from the main call to be passed to the initialisation and stopping criterion functions (slots \code{onInit} and \code{Stop} respectively).} \item{.stop}{specification of a stopping criterion, that is used instead of the one associated to the NMF algorithm. It may be specified as: \itemize{ \item the access key of a registered stopping criterion; \item a single integer that specifies the exact number of iterations to perform, which will be honoured unless a lower value is explicitly passed in argument \code{maxIter}. \item a single numeric value that specifies the stationnarity threshold for the objective function, used in with \code{\link{nmf.stop.stationary}}; \item a function with signature \code{(object="NMFStrategy", i="integer", y="matrix", x="NMF", ...)}, where \code{object} is the \code{NMFStrategy} object that describes the algorithm being run, \code{i} is the current iteration, \code{y} is the target matrix and \code{x} is the current value of the NMF model. }} \item{maxIter}{maximum number of iterations to perform.} \item{stopconv}{number of iterations intervals over which the connectivity matrix must not change for stationarity to be achieved.} \item{check.interval}{interval (in number of iterations) on which the stopping criterion is computed.} \item{w}{current basis matrix} \item{h}{current coefficient matrix} } \value{ an \code{\linkS4class{NMFOffset}} model object. } \description{ These update rules proposed by \cite{Badea (2008)} are modified version of the updates from \cite{Lee et al. (2001)}, that include an offset/intercept vector, which models a common baseline for each feature accross all samples: \deqn{V \approx W H + I} \code{nmf_update.euclidean_offset.h} and \code{nmf_update.euclidean_offset.w} compute the updated NMFOffset model, using the optimized \emph{C++} implementations. \code{nmf_update.offset_R} implements a complete single update step, using plain R updates. \code{nmf_update.offset} implements a complete single update step, using C++-optimised updates. Algorithms \sQuote{offset} and \sQuote{.R#offset} provide the complete NMF-with-offset algorithm from \cite{Badea (2008)}, using the C++-optimised and pure R updates \code{\link{nmf_update.offset}} and \code{\link{nmf_update.offset_R}} respectively. } \details{ The associated model is defined as an \code{\linkS4class{NMFOffset}} object. The details of the multiplicative updates can be found in \cite{Badea (2008)}. Note that the updates are the ones defined for a single datasets, not the simultaneous NMF model, which is fit by algorithm \sQuote{siNMF} from formula-based NMF models. } \author{ Original update definition: Liviu Badea Port to R and optimisation in C++: Renaud Gaujoux } \references{ Badea L (2008). "Extracting gene expression profiles common to colon and pancreatic adenocarcinoma using simultaneous nonnegative matrix factorization." _Pacific Symposium on Biocomputing. Pacific Symposium on Biocomputing_, *290*, pp. 267-78. ISSN 1793-5091, . Lee DD and Seung H (2001). "Algorithms for non-negative matrix factorization." _Advances in neural information processing systems_. . } NMF/man/txtProgressBar.Rd0000644000176000001440000000316312234465004014760 0ustar ripleyusers\name{txtProgressBar} \alias{txtProgressBar} \title{Simple Progress Bar} \usage{ txtProgressBar(min = 0, max = 1, initial = 0, char = "=", width = NA, title = if (style == 3) " ", label, style = 1, file = "", shared = NULL) } \arguments{ \item{shared}{specification of a shared directory to use when the progress bar is to be used by multiple processes.} \item{min}{(finite) numeric values for the extremes of the progress bar. Must have \code{min < max}.} \item{max}{(finite) numeric values for the extremes of the progress bar. Must have \code{min < max}.} \item{initial}{initial or new value for the progress bar. See \sQuote{Details} for what happens with invalid values.} \item{char}{the character (or character string) to form the progress bar.} \item{width}{the width of the progress bar, as a multiple of the width of \code{char}. If \code{NA}, the default, the number of characters is that which fits into \code{getOption("width")}.} \item{title}{ignored, for compatibility with other progress bars.} \item{label}{ignored, for compatibility with other progress bars.} \item{style}{the \sQuote{style} of the bar -- see \sQuote{Details}.} \item{file}{an open connection object or \code{""} which indicates the console: \code{\link{stderr}()} might be useful here.} } \description{ Creates a simple progress bar with title. This function is identical to \code{utils::txtProgressBar} but allow adding a title to the progress bar, and can be shared by multiple processes, e.g., in multicore or multi-hosts computations. } \author{ R Core Team } \keyword{internal} NMF/man/setNMFSeed.Rd0000644000176000001440000000411012234465004013715 0ustar ripleyusers\docType{methods} \name{NMFSeed} \alias{NMFSeed} \alias{NMFSeed,character-method} \alias{NMFSeed-methods} \alias{NMFSeed,NMFSeed-method} \alias{removeNMFSeed} \alias{setNMFSeed} \title{\code{NMFSeed} is a constructor method that instantiate \code{\linkS4class{NMFSeed}} objects.} \usage{ NMFSeed(key, method, ...) setNMFSeed(..., overwrite = isLoadingNamespace(), verbose = TRUE) removeNMFSeed(name, ...) } \arguments{ \item{key}{access key as a single character string} \item{method}{specification of the seeding method, as a function that takes at least the following arguments: \describe{ \item{object}{uninitialised/empty NMF model, i.e. that it has 0 rows and columns, but has already the rank requested in the call to \code{\link{nmf}} or \code{\link{seed}}.} \item{x}{target matrix} \item{...}{extra arguments} }} \item{...}{arguments passed to \code{NMFSeed} and used to initialise slots in the \code{\linkS4class{NMFSeed}} object, or to \code{\link[pkgmaker]{pkgreg_remove}}.} \item{name}{name of the seeding method.} \item{overwrite}{logical that indicates if any existing NMF method with the same name should be overwritten (\code{TRUE}) or not (\code{FALSE}), in which case an error is thrown.} \item{verbose}{a logical that indicates if information about the registration should be printed (\code{TRUE}) or not (\code{FALSE}).} } \description{ \code{NMFSeed} is a constructor method that instantiate \code{\linkS4class{NMFSeed}} objects. NMF seeding methods are registered via the function \code{setNMFSeed}, which stores them as \code{\linkS4class{NMFSeed}} objects in a dedicated registry. \code{removeNMFSeed} removes an NMF seeding method from the registry. } \section{Methods}{ \describe{ \item{NMFSeed}{\code{signature(key = "character")}: Default method simply calls \code{\link{new}} with the same arguments. } \item{NMFSeed}{\code{signature(key = "NMFSeed")}: Creates an \code{NMFSeed} based on a template object (Constructor-Copy), in particular it uses the \strong{same} name. } } } \keyword{methods} NMF/man/silhouette.NMF.Rd0000644000176000001440000000454712305630424014601 0ustar ripleyusers\name{silhouette.NMF} \alias{silhouette.NMF} \title{Silhouette of NMF Clustering} \usage{ \method{silhouette}{NMF} (x, what = NULL, order = NULL, ...) } \arguments{ \item{x}{an NMF object, as returned by \code{\link{nmf}}.} \item{what}{defines the type of clustering the computed silhouettes are meant to assess: \code{'samples'} for the clustering of samples (i.e. the columns of the target matrix), \code{'features'} for the clustering of features (i.e. the rows of the target matrix), and \code{'chc'} for the consensus clustering of samples as defined by hierarchical clustering dendrogram, \code{'consensus'} for the consensus clustering of samples, with clustered ordered as in the \strong{default} hierarchical clustering used by \code{\link{consensusmap}} when plotting the heatmap of the consensus matrix (for multi-run NMF fits). That is \code{dist = 1 - consensus(x)}, average linkage and reordering based on row means.} \item{order}{integer indexing vector that can be used to force the silhouette order.} \item{...}{extra arguments not used.} } \description{ Silhouette of NMF Clustering } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } x <- rmatrix(100, 20, dimnames = list(paste0('a', 1:100), letters[1:20])) # NB: using low value for maxIter for the example purpose only res <- nmf(x, 4, nrun = 5, maxIter = 50) # sample clustering from best fit plot(silhouette(res)) # from consensus plot(silhouette(res, what = 'consensus')) # feature clustering plot(silhouette(res, what = 'features')) # average silhouette are computed in summary measures summary(res) # consensus silhouettes are ordered as on default consensusmap heatmap \dontrun{ op <- par(mfrow = c(1,2)) } consensusmap(res) si <- silhouette(res, what = 'consensus') plot(si) \dontrun{ par(op) } # if the order is based on some custom numeric weights \dontrun{ op <- par(mfrow = c(1,2)) } cm <- consensusmap(res, Rowv = runif(ncol(res))) # NB: use reverse order because silhouettes are plotted top-down si <- silhouette(res, what = 'consensus', order = rev(cm$rowInd)) plot(si) \dontrun{ par(op) } # do the reverse: order the heatmap as a set of silhouettes si <- silhouette(res, what = 'features') \dontrun{ op <- par(mfrow = c(1,2)) } basismap(res, Rowv = si) plot(si) \dontrun{ par(op) } } \seealso{ \code{\link[NMF]{predict}} } NMF/man/cophcor.Rd0000644000176000001440000000404312234465004013422 0ustar ripleyusers\docType{methods} \name{cophcor} \alias{cophcor} \alias{cophcor,matrix-method} \alias{cophcor-methods} \alias{cophcor,NMFfitX-method} \title{Cophenetic Correlation Coefficient} \usage{ cophcor(object, ...) \S4method{cophcor}{matrix}(object, linkage = "average") } \arguments{ \item{object}{an object from which is extracted a consensus matrix.} \item{...}{extra arguments to allow extension and passed to subsequent calls.} \item{linkage}{linkage method used in the hierarchical clustering. It is passed to \code{\link{hclust}}.} } \description{ The function \code{cophcor} computes the cophenetic correlation coefficient from consensus matrix \code{object}, e.g. as obtained from multiple NMF runs. } \details{ The cophenetic correlation coeffificient is based on the consensus matrix (i.e. the average of connectivity matrices) and was proposed by \cite{Brunet et al. (2004)} to measure the stability of the clusters obtained from NMF. It is defined as the Pearson correlation between the samples' distances induced by the consensus matrix (seen as a similarity matrix) and their cophenetic distances from a hierachical clustering based on these very distances (by default an average linkage is used). See \cite{Brunet et al. (2004)}. } \section{Methods}{ \describe{ \item{cophcor}{\code{signature(object = "matrix")}: Workhorse method for matrices. } \item{cophcor}{\code{signature(object = "NMFfitX")}: Computes the cophenetic correlation coefficient on the consensus matrix of \code{object}. All arguments in \code{...} are passed to the method \code{cophcor,matrix}. } } } \references{ Brunet J, Tamayo P, Golub TR and Mesirov JP (2004). "Metagenes and molecular pattern discovery using matrix factorization." _Proceedings of the National Academy of Sciences of the United States of America_, *101*(12), pp. 4164-9. ISSN 0027-8424, , . } \seealso{ \code{\link{cophenetic}} } \keyword{methods} NMF/man/consensus-commaNMFfitX1-method.Rd0000644000176000001440000000132512234465004017632 0ustar ripleyusers\docType{methods} \name{consensus,NMFfitX1-method} \alias{consensus,NMFfitX1-method} \title{Returns the consensus matrix computed while performing all NMF runs, amongst which \code{object} was selected as the best fit.} \usage{ \S4method{consensus}{NMFfitX1}(object, no.attrib = FALSE) } \arguments{ \item{object}{an object with a suitable \code{\link{predict}} method.} \item{no.attrib}{a logical that indicates if attributes containing information about the NMF model should be attached to the result (\code{TRUE}) or not (\code{FALSE}).} } \description{ The result is the matrix stored in slot \sQuote{consensus}. This method returns \code{NULL} if the consensus matrix is empty. } \keyword{methods} NMF/man/NMFfitX-class.Rd0000644000176000001440000001460012305630424014342 0ustar ripleyusers\docType{class} \name{NMFfitX-class} \alias{NMFfitX-class} \title{Virtual Class to Handle Results from Multiple Runs of NMF Algorithms} \description{ This class defines a common interface to handle the results from multiple runs of a single NMF algorithm, performed with the \code{\link{nmf}} method. } \details{ Currently, this interface is implemented by two classes, \code{\linkS4class{NMFfitX1}} and \code{\linkS4class{NMFfitXn}}, which respectively handle the case where only the best fit is kept, and the case where the list of all the fits is returned. See \code{\link{nmf}} for more details on the method arguments. } \section{Slots}{ \describe{ \item{runtime.all}{Object of class \code{\link[=proc.time]{proc_time}} that contains CPU times required to perform all the runs.} } } \section{Methods}{ \describe{ \item{basismap}{\code{signature(object = "NMFfitX")}: Plots a heatmap of the basis matrix of the best fit in \code{object}. } \item{coefmap}{\code{signature(object = "NMFfitX")}: Plots a heatmap of the coefficient matrix of the best fit in \code{object}. This method adds: \itemize{ \item an extra special column annotation track for multi-run NMF fits, \code{'consensus:'}, that shows the consensus cluster associated to each sample. \item a column sorting schema \code{'consensus'} that can be passed to argument \code{Colv} and orders the columns using the hierarchical clustering of the consensus matrix with average linkage, as returned by \code{\link{consensushc}(object)}. This is also the ordering that is used by default for the heatmap of the consensus matrix as ploted by \code{\link{consensusmap}}. } } \item{consensus}{\code{signature(object = "NMFfitX")}: Pure virtual method defined to ensure \code{consensus} is defined for sub-classes of \code{NMFfitX}. It throws an error if called. } \item{consensushc}{\code{signature(object = "NMFfitX")}: Compute the hierarchical clustering on the consensus matrix of \code{object}, or on the connectivity matrix of the best fit in \code{object}. } \item{consensusmap}{\code{signature(object = "NMFfitX")}: Plots a heatmap of the consensus matrix obtained when fitting an NMF model with multiple runs. } \item{cophcor}{\code{signature(object = "NMFfitX")}: Computes the cophenetic correlation coefficient on the consensus matrix of \code{object}. All arguments in \code{...} are passed to the method \code{cophcor,matrix}. } \item{deviance}{\code{signature(object = "NMFfitX")}: Returns the deviance achieved by the best fit object, i.e. the lowest deviance achieved across all NMF runs. } \item{dispersion}{\code{signature(object = "NMFfitX")}: Computes the dispersion on the consensus matrix obtained from multiple NMF runs. } \item{fit}{\code{signature(object = "NMFfitX")}: Returns the model object that achieves the lowest residual approximation error across all the runs. It is a pure virtual method defined to ensure \code{fit} is defined for sub-classes of \code{NMFfitX}, which throws an error if called. } \item{getRNG1}{\code{signature(object = "NMFfitX")}: Returns the RNG settings used for the first NMF run of multiple NMF runs. } \item{ibterms}{\code{signature(object = "NMFfitX")}: Method for multiple NMF fit objects, which returns the indexes of fixed basis terms from the best fitted model. } \item{metaHeatmap}{\code{signature(object = "NMFfitX")}: Deprecated method subsituted by \code{\link{consensusmap}}. } \item{minfit}{\code{signature(object = "NMFfitX")}: Returns the fit object that achieves the lowest residual approximation error across all the runs. It is a pure virtual method defined to ensure \code{minfit} is defined for sub-classes of \code{NMFfitX}, which throws an error if called. } \item{nmf.equal}{\code{signature(x = "NMFfitX", y = "NMF")}: Compares two NMF models when at least one comes from multiple NMF runs. } \item{NMFfitX}{\code{signature(object = "NMFfitX")}: Provides a way to aggregate \code{NMFfitXn} objects into an \code{NMFfitX1} object. } \item{nrun}{\code{signature(object = "NMFfitX")}: Returns the number of NMF runs performed to create \code{object}. It is a pure virtual method defined to ensure \code{nrun} is defined for sub-classes of \code{NMFfitX}, which throws an error if called. See \code{\link{nrun,NMFfitX-method}} for more details. } \item{predict}{\code{signature(object = "NMFfitX")}: Returns the cluster membership index from an NMF model fitted with multiple runs. Besides the type of clustering available for any NMF models (\code{'columns', 'rows', 'samples', 'features'}), this method can return the cluster membership index based on the consensus matrix, computed from the multiple NMF runs. See \code{\link{predict,NMFfitX-method}} for more details. } \item{residuals}{\code{signature(object = "NMFfitX")}: Returns the residuals achieved by the best fit object, i.e. the lowest residual approximation error achieved across all NMF runs. } \item{runtime.all}{\code{signature(object = "NMFfitX")}: Returns the CPU time required to compute all the NMF runs. It returns \code{NULL} if no CPU data is available. } \item{show}{\code{signature(object = "NMFfitX")}: Show method for objects of class \code{NMFfitX} } \item{summary}{\code{signature(object = "NMFfitX")}: Computes a set of measures to help evaluate the quality of the \emph{best fit} of the set. The result is similar to the result from the \code{summary} method of \code{NMFfit} objects. See \code{\linkS4class{NMF}} for details on the computed measures. In addition, the cophenetic correlation (\code{\link{cophcor}}) and \code{\link{dispersion}} coefficients of the consensus matrix are returned, as well as the total CPU time (\code{\link{runtime.all}}). } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # generate a synthetic dataset with known classes n <- 20; counts <- c(5, 2, 3); V <- syntheticNMF(n, counts) # perform multiple runs of one algorithm (default is to keep only best fit) res <- nmf(V, 3, nrun=3) res # plot a heatmap of the consensus matrix \dontrun{ consensusmap(res) } # perform multiple runs of one algorithm (keep all the fits) res <- nmf(V, 3, nrun=3, .options='k') res } \seealso{ Other multipleNMF: \code{\link{NMFfitX1-class}}, \code{\link{NMFfitXn-class}} } NMF/man/fit.Rd0000644000176000001440000000746212234470405012560 0ustar ripleyusers\docType{methods} \name{fit} \alias{fit} \alias{fit<-} \alias{fit<--methods} \alias{fit-methods} \alias{fit,NMFfit-method} \alias{fit<-,NMFfit,NMF-method} \alias{fit,NMFfitX1-method} \alias{fit,NMFfitX-method} \alias{fit,NMFfitXn-method} \alias{minfit} \alias{minfit-methods} \alias{minfit,NMFfit-method} \alias{minfit,NMFfitX1-method} \alias{minfit,NMFfitX-method} \alias{minfit,NMFfitXn-method} \title{Extracting Fitted Models} \usage{ fit(object, ...) fit(object)<-value minfit(object, ...) } \arguments{ \item{object}{an object fitted by some algorithm, e.g. as returned by the function \code{\link{nmf}}.} \item{value}{replacement value} \item{...}{extra arguments to allow extension} } \description{ The functions \code{fit} and \code{minfit} are S4 genetics that extract the best model object and the best fit object respectively, from a collection of models or from a wrapper object. \code{fit<-} sets the fitted model in a fit object. It is meant to be called only when developing new NMF algorithms, e.g. to update the value of the model stored in the starting point. } \details{ A fit object differs from a model object in that it contains data about the fit, such as the initial RNG settings, the CPU time used, etc\ldots, while a model object only contains the actual modelling data such as regression coefficients, loadings, etc\ldots That best model is generally defined as the one that achieves the maximum/minimum some quantitative measure, amongst all models in a collection. In the case of NMF models, the best model is the one that achieves the best approximation error, according to the objective function associated with the algorithm that performed the fit(s). } \section{Methods}{ \describe{ \item{fit}{\code{signature(object = "NMFfit")}: Returns the NMF model object stored in slot \code{'fit'}. } \item{fit}{\code{signature(object = "NMFfitX")}: Returns the model object that achieves the lowest residual approximation error across all the runs. It is a pure virtual method defined to ensure \code{fit} is defined for sub-classes of \code{NMFfitX}, which throws an error if called. } \item{fit}{\code{signature(object = "NMFfitX1")}: Returns the model object associated with the best fit, amongst all the runs performed when fitting \code{object}. Since \code{NMFfitX1} objects only hold the best fit, this method simply returns the NMF model fitted by \code{object} -- that is stored in slot \sQuote{fit}. } \item{fit}{\code{signature(object = "NMFfitXn")}: Returns the best NMF fit object amongst all the fits stored in \code{object}, i.e. the fit that achieves the lowest estimation residuals. } \item{fit<-}{\code{signature(object = "NMFfit", value = "NMF")}: Updates the NMF model object stored in slot \code{'fit'} with a new value. } \item{minfit}{\code{signature(object = "NMFfit")}: Returns the object its self, since there it is the result of a single NMF run. } \item{minfit}{\code{signature(object = "NMFfitX")}: Returns the fit object that achieves the lowest residual approximation error across all the runs. It is a pure virtual method defined to ensure \code{minfit} is defined for sub-classes of \code{NMFfitX}, which throws an error if called. } \item{minfit}{\code{signature(object = "NMFfitX1")}: Returns the fit object associated with the best fit, amongst all the runs performed when fitting \code{object}. Since \code{NMFfitX1} objects only hold the best fit, this method simply returns \code{object} coerced into an \code{NMFfit} object. } \item{minfit}{\code{signature(object = "NMFfitXn")}: Returns the best NMF model in the list, i.e. the run that achieved the lower estimation residuals. The model is selected based on its \code{deviance} value. } } } \keyword{methods} NMF/man/bioc.Rd0000644000176000001440000000247112234465004012704 0ustar ripleyusers\name{bioc-NMF} \alias{.atrack,ExpressionSet-method} \alias{bioc-NMF} \alias{featureNames,NMFfitX-method} \alias{featureNames<-,NMF-method} \alias{featureNames,NMF-method} \alias{metagenes} \alias{metagenes<-} \alias{metaprofiles} \alias{metaprofiles<-} \alias{nmeta} \alias{nmf,ExpressionSet,ANY,ANY-method} \alias{nmf,matrix,ExpressionSet,ANY-method} \alias{nmfModel,ANY,ExpressionSet-method} \alias{nmfModel,ExpressionSet,ANY-method} \alias{nneg,ExpressionSet-method} \alias{rnmf,ANY,ExpressionSet-method} \alias{rposneg,ExpressionSet-method} \alias{run,NMFStrategy,ExpressionSet,ANY-method} \alias{sampleNames<-,NMF,ANY-method} \alias{sampleNames,NMFfitX-method} \alias{sampleNames,NMF-method} \alias{seed,ExpressionSet,ANY,ANY-method} \title{Specific NMF Layer for Bioconductor} \description{ The package NMF provides an optional layer for working with common objects and functions defined in the Bioconductor platform. } \details{ It provides: \itemize{ \item computation functions that support \code{ExpressionSet} objects as inputs. \item aliases and methods for generic functions defined and widely used by Bioconductor base packages. \item specialised visualisation methods that adapt the titles and legend using bioinformatics terminology. \item functions to link the results with annotations, etc... } } NMF/man/NMF-package.Rd0000644000176000001440000000216212305630424013775 0ustar ripleyusers\docType{package} \name{NMF-package} \alias{NMF} \alias{NMF-package} \title{Algorithms and framework for Nonnegative Matrix Factorization (NMF).} \description{ This package provides a framework to perform Non-negative Matrix Factorization (NMF). It implements a set of already published algorithms and seeding methods, and provides a framework to test, develop and plug new/custom algorithms. Most of the built-in algorithms have been optimized in C++, and the main interface function provides an easy way of performing parallel computations on multicore machines. } \details{ \code{\link{nmf}} Run a given NMF algorithm } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # generate a synthetic dataset with known classes n <- 50; counts <- c(5, 5, 8); V <- syntheticNMF(n, counts) # perform a 3-rank NMF using the default algorithm res <- nmf(V, 3) basismap(res) coefmap(res) } \author{ Renaud Gaujoux \email{renaud@cbio.uct.ac.za} } \references{ \url{http://cran.r-project.org/} \url{http://nmf.r-forge.project.org} } \seealso{ \code{\link{nmf}} } \keyword{package} NMF/man/staticVar.Rd0000644000176000001440000000155212234465004013727 0ustar ripleyusers\name{staticVar} \alias{staticVar} \title{Get/Set a Static Variable in NMF Algorithms} \usage{ staticVar(name, value, init = FALSE) } \arguments{ \item{name}{Name of the static variable (as a single character string)} \item{value}{New value of the static variable} \item{init}{a logical used when a \code{value} is provided, that specifies if the variable should be set to the new value only if it does not exist yet (\code{init=TRUE}).} } \value{ The value of the static variable } \description{ This function is used in iterative NMF algorithms to manage variables stored in a local workspace, that are accessible to all functions that define the iterative schema described in \code{\linkS4class{NMFStrategyIterative}}. It is specially useful for computing stopping criteria, which often require model data from different iterations. } NMF/man/seed.Rd0000644000176000001440000000705112234465004012707 0ustar ripleyusers\docType{methods} \name{seed} \alias{seed} \alias{seed,ANY,ANY,character-method} \alias{seed,ANY,ANY,function-method} \alias{seed,ANY,ANY,missing-method} \alias{seed,ANY,ANY,NULL-method} \alias{seed,ANY,ANY,numeric-method} \alias{seed,ANY,list,NMFSeed-method} \alias{seed,ANY,numeric,NMFSeed-method} \alias{seed,matrix,NMF,NMFSeed-method} \alias{seed-methods} \title{Interface for NMF Seeding Methods} \usage{ seed(x, model, method, ...) \S4method{seed}{matrix,NMF,NMFSeed}(x, model, method, rng, ...) \S4method{seed}{ANY,ANY,function}(x, model, method, name, ...) } \arguments{ \item{x}{target matrix one wants to approximate with NMF} \item{model}{specification of the NMF model, e.g., the factorization rank.} \item{method}{specification of a seeding method. See each method for details on the supported formats.} \item{...}{extra to allow extensions and passed down to the actual seeding method.} \item{rng}{rng setting to use. If not missing the RNG settings are set and restored on exit using \code{\link{setRNG}}. All arguments in \code{...} are passed to teh seeding strategy.} \item{name}{optional name of the seeding method for custom seeding strategies.} } \value{ an \code{\linkS4class{NMFfit}} object. } \description{ The function \code{seed} provides a single interface for calling all seeding methods used to initialise NMF computations. These methods at least set the basis and coefficient matrices of the initial \code{object} to valid nonnegative matrices. They will be used as a starting point by any NMF algorithm that accept initialisation. IMPORTANT: this interface is still considered experimental and is subject to changes in future release. } \section{Methods}{ \describe{ \item{seed}{\code{signature(x = "matrix", model = "NMF", method = "NMFSeed")}: This is the workhorse method that seeds an NMF model object using a given seeding strategy defined by an \code{NMFSeed} object, to fit a given target matrix. } \item{seed}{\code{signature(x = "ANY", model = "ANY", method = "function")}: Seeds an NMF model using a custom seeding strategy, defined by a function. \code{method} must have signature \code{(x='NMFfit', y='matrix', ...)}, where \code{x} is the unseeded NMF model and \code{y} is the target matrix to fit. It must return an \code{\linkS4class{NMF}} object, that contains the seeded NMF model. } \item{seed}{\code{signature(x = "ANY", model = "ANY", method = "missing")}: Seeds the model with the default seeding method given by \code{nmf.getOption('default.seed')} } \item{seed}{\code{signature(x = "ANY", model = "ANY", method = "NULL")}: Use NMF method \code{'none'}. } \item{seed}{\code{signature(x = "ANY", model = "ANY", method = "numeric")}: Use \code{method} to set the RNG with \code{\link{setRNG}} and use method \dQuote{random} to seed the NMF model. Note that in this case the RNG settings are not restored. This is due to some internal technical reasons, and might change in future releases. } \item{seed}{\code{signature(x = "ANY", model = "ANY", method = "character")}: Use the registered seeding method whose access key is \code{method}. } \item{seed}{\code{signature(x = "ANY", model = "list", method = "NMFSeed")}: Seed a model using the elements in \code{model} to instantiate it with \code{\link{nmfModel}}. } \item{seed}{\code{signature(x = "ANY", model = "numeric", method = "NMFSeed")}: Seeds a standard NMF model (i.e. of class \code{\linkS4class{NMFstd}}) of rank \code{model}. } } } \keyword{methods} NMF/man/show-commaNMFStrategyIterative-method.Rd0000644000176000001440000000056212234465004021260 0ustar ripleyusers\docType{methods} \name{show,NMFStrategyIterative-method} \alias{show,NMFStrategyIterative-method} \title{Show method for objects of class \code{NMFStrategyIterative}} \usage{ \S4method{show}{NMFStrategyIterative}(object) } \arguments{ \item{object}{Any R object} } \description{ Show method for objects of class \code{NMFStrategyIterative} } \keyword{methods} NMF/man/advanced.Rd0000644000176000001440000000125712234465004013536 0ustar ripleyusers\name{advanced-NMF} \alias{advanced-NMF} \alias{which.best} \title{Advanced Usage of the Package NMF} \usage{ which.best(object, FUN = deviance, ...) } \arguments{ \item{object}{an NMF model fitted by multiple runs.} \item{FUN}{the function that computes the quantitative measure.} \item{...}{extra arguments passed to \code{FUN}.} } \description{ The functions documented here provide advanced functionalities useful when developing within the framework implemented in the NMF package. \code{which.best} returns the index of the best fit in a list of NMF fit, according to some quantitative measure. The index of the fit with the lowest measure is returned. } NMF/man/nmf.Rd0000644000176000001440000007441612305630424012557 0ustar ripleyusers\docType{methods} \name{nmf} \alias{nmf} \alias{nmf,data.frame,ANY,ANY-method} \alias{nmf,formula,ANY,ANY-method} \alias{nmf,matrix,data.frame,ANY-method} \alias{nmf,matrix,matrix,ANY-method} \alias{nmf,matrix,missing,ANY-method} \alias{nmf,matrix,NMF,ANY-method} \alias{nmf,matrix,NULL,ANY-method} \alias{nmf,matrix,numeric,character-method} \alias{nmf,matrix,numeric,function-method} \alias{nmf,matrix,numeric,list-method} \alias{nmf,matrix,numeric,missing-method} \alias{nmf,matrix,numeric,NMFStrategy-method} \alias{nmf,matrix,numeric,NULL-method} \alias{nmf-methods} \title{Running NMF algorithms} \usage{ nmf(x, rank, method, ...) \S4method{nmf}{matrix,numeric,NULL}(x, rank, method, seed = NULL, model = NULL, ...) \S4method{nmf}{matrix,numeric,list}(x, rank, method, ..., .parameters = list()) \S4method{nmf}{matrix,numeric,function}(x, rank, method, seed, model = "NMFstd", ..., name, objective = "euclidean", mixed = FALSE) \S4method{nmf}{matrix,NMF,ANY}(x, rank, method, seed, ...) \S4method{nmf}{matrix,NULL,ANY}(x, rank, method, seed, ...) \S4method{nmf}{matrix,matrix,ANY}(x, rank, method, seed, model = list(), ...) \S4method{nmf}{formula,ANY,ANY}(x, rank, method, ..., model = NULL) \S4method{nmf}{matrix,numeric,NMFStrategy}(x, rank, method, seed = nmf.getOption("default.seed"), rng = NULL, nrun = if (length(rank) > 1) 30 else 1, model = NULL, .options = list(), .pbackend = nmf.getOption("pbackend"), .callback = NULL, ...) } \arguments{ \item{x}{target data to fit, i.e. a matrix-like object} \item{rank}{specification of the factorization rank. It is usually a single numeric value, but other type of values are possible (e.g. matrix), for which specific methods are implemented. See for example methods \code{nmf,matrix,matrix,ANY}. If \code{rank} is a numeric vector with more than one element, e.g. a range of ranks, then \code{\link{nmf}} performs the estimation procedure described in \code{\link{nmfEstimateRank}}.} \item{method}{specification of the NMF algorithm. The most common way of specifying the algorithm is to pass the access key (i.e. a character string) of an algorithm stored in the package's dedicated registry, but methods exists that handle other types of values, such as \code{function} or \code{list} object. See their descriptions in section \emph{Methods}. If \code{method} is missing the algorithm to use is obtained from the option \code{nmf.getOption('default.algorithm')}, unless it can be infer from the type of NMF model to fit, if this later is available from other arguments. Factory fresh default value is \sQuote{brunet}, which corresponds to the standard NMF algorithm from \cite{Brunet2004} (see section \emph{Algorithms}). Cases where the algorithm is inferred from the call are when an NMF model is passed in arguments \code{rank} or \code{seed} (see description for \code{nmf,matrix,numeric,NULL} in section \emph{Methods}).} \item{...}{extra arguments to allow extension of the generic. Arguments that are not used in the chain of internal calls to \code{nmf} methods are passed to the function that effectively implements the algorithm that fits an NMF model on \code{x}.} \item{.parameters}{list of method-specific parameters. Its elements must have names matching a single method listed in \code{method}, and be lists of named values that are passed to the corresponding method.} \item{name}{name associated with the NMF algorithm implemented by the function \code{method} [only used when \code{method} is a function].} \item{objective}{specification of the objective function associated with the algorithm implemented by the function \code{method} [only used when \code{method} is a function]. It may be either \code{'euclidean'} or \code{'KL'} for specifying the euclidean distance (Frobenius norm) or the Kullback-Leibler divergence respectively, or a function with signature \code{(x="NMF", y="matrix", ...)} that computes the objective value for an NMF model \code{x} on a target matrix \code{y}, i.e. the residuals between the target matrix and its NMF estimate. Any extra argument may be specified, e.g. \code{function(x, y, alpha, beta=2, ...)}.} \item{mixed}{a logical that indicates if the algorithm implemented by the function \code{method} support mixed-sign target matrices, i.e. that may contain negative values [only used when \code{method} is a function].} \item{seed}{specification of the starting point or seeding method, which will compute a starting point, usually using data from the target matrix in order to provide a good guess. The seeding method may be specified in the following way: \describe{ \item{a \code{character} string:}{ giving the name of a \emph{registered} seeding method. The corresponding method will be called to compute the starting point. Available methods can be listed via \code{nmfSeed()}. See its dedicated documentation for details on each available registered methods (\code{\link{nmfSeed}}). } \item{a \code{list}:}{ giving the name of a \emph{registered} seeding method and, optionally, extra parameters to pass to it.} \item{a single \code{numeric}:}{ that is used to seed the random number generator, before generating a random starting point. Note that when performing multiple runs, the L'Ecuyer's RNG is used in order to produce a sequence of random streams, that is used in way that ensures that parallel computation are fully reproducible. } \item{an object that inherits from \code{\linkS4class{NMF}}:}{ it should contain the data of an initialised NMF model, i.e. it must contain valid basis and mixture coefficient matrices, directly usable by the algorithm's workhorse function.} \item{a \code{function}:}{ that computes the starting point. It must have signature \code{(object="NMF", target="matrix", ...)} and return an object that inherits from class \code{NMF}. It is recommended to use argument \code{object} as a template for the returned object, by only updating the basis and coefficient matrices, using \code{\link{basis<-}} and \code{\link{coef<-}} respectively. } }} \item{rng}{rng specification for the run(s). This argument should be used to set the the RNG seed, while still specifying the seeding method argument \var{seed}.} \item{model}{specification of the type of NMF model to use. It is used to instantiate the object that inherits from class \code{\linkS4class{NMF}}, that will be passed to the seeding method. The following values are supported: \itemize{ \item \code{NULL}, the default model associated to the NMF algorithm is instantiated and \code{...} is looked-up for arguments with names that correspond to slots in the model class, which are passed to the function \code{\link{nmfModel}} to instantiate the model. Arguments in \code{...} that do not correspond to slots are passed to the algorithm. \item a single \code{character} string, that is the name of the NMF model class to be instantiate. In this case, arguments in \code{...} are handled in the same way as when \code{model} is \code{NULL}. \item a \code{list} that contains named values that are passed to the function \code{\link{nmfModel}} to instantiate the model. In this case, \code{...} is not looked-up at all, and passed entirely to the algorithm. This means that all necessary model parameters must be specified in \code{model}. } \strong{Argument/slot conflicts:} In the case a parameter of the algorithm has the same name as a model slot, then \code{model} MUST be a list -- possibly empty --, if one wants this parameter to be effectively passed to the algorithm. If a variable appears in both arguments \code{model} and \code{\dots}, the former will be used to initialise the NMF model, the latter will be passed to the NMF algorithm. See code examples for an illustration of this situation.} \item{nrun}{number of runs to perform. It specifies the number of runs to perform. By default only one run is performed, except if \code{rank} is a numeric vector with more than one element, in which case a default of 30 runs per value of the rank are performed, allowing the computation of a consensus matrix that is used in selecting the appropriate rank (see \code{\link{consensus}}). When using a random seeding method, multiple runs are generally required to achieve stability and avoid \emph{bad} local minima.} \item{.options}{this argument is used to set runtime options. It can be a \code{list} containing named options with their values, or, in the case only boolean/integer options need to be set, a character string that specifies which options are turned on/off or their value, in a unix-like command line argument way. The string must be composed of characters that correspond to a given option (see mapping below), and modifiers '+' and '-' that toggle options on and off respectively. E.g. \code{.options='tv'} will toggle on options \code{track} and \code{verbose}, while \code{.options='t-v'} will toggle on option \code{track} and toggle off option \code{verbose}. Modifiers '+' and '-' apply to all option character found after them: \code{t-vp+k} means \code{track=TRUE}, \code{verbose=parallel=FALSE}, and \code{keep.all=TRUE}. The default behaviour is to assume that \code{.options} starts with a '+'. for options that accept integer values, the value may be appended to the option's character e.g. \code{'p4'} for asking for 4 processors or \code{'v3'} for showing verbosity message up to level 3. The following options are available (the characters after \dQuote{-} are those to use to encode \code{.options} as a string): \describe{ \item{debug - d}{ Toggle debug mode (default: \code{FALSE}). Like option \code{verbose} but with more information displayed.} \item{keep.all - k}{ used when performing multiple runs (\code{nrun}>1): if \code{TRUE}, all factorizations are saved and returned (default: \code{FALSE}). Otherwise only the factorization achieving the minimum residuals is returned.} \item{parallel - p}{ this option is useful on multicore *nix or Mac machine only, when performing multiple runs (\code{nrun} > 1) (default: \code{TRUE}). If \code{TRUE}, the runs are performed using the parallel foreach backend defined in argument \code{.pbackend}. If this is set to \code{'mc'} or \code{'par'} then \code{nmf} tries to perform the runs using multiple cores with package \code{link[doParallel]{doParallel}} -- which therefore needs to be installed. If equal to an integer, then \code{nmf} tries to perform the computation on the specified number of processors. When passing options as a string the number is appended to the option's character e.g. \code{'p4'} for asking for 4 processors. If \code{FALSE}, then the computation is performed sequentially using the base function \code{\link{sapply}}. Unlike option 'P' (capital 'P'), if the computation cannot be performed in parallel, then it will still be carried on sequentially. \strong{IMPORTANT NOTE FOR MAC OS X USERS:} The parallel computation is based on the \code{doMC} and \code{multicore} packages, so the same care should be taken as stated in the vignette of \code{doMC}: \emph{\dQuote{it is not safe to use doMC from R.app on Mac OS X. Instead, you should use doMC from a terminal session, starting R from the command line.}} } \item{parallel.required - P}{ Same as \code{p}, but an error is thrown if the computation cannot be performed in parallel or with the specified number of processors.} \item{shared.memory - m}{ toggle usage of shared memory (requires the \pkg{synchronicity} package). Default is as defined by \code{nmf.getOption('shared.memory')}.} \item{restore.seed - r}{ deprecated option since version 0.5.99. Will throw a warning if used.} \item{simplifyCB - S}{ toggle simplification of the callback results. Default is \code{TRUE}} \item{track - t}{ enables error tracking (default: FALSE). If \code{TRUE}, the returned object's slot \code{residuals} contains the trajectory of the objective values, which can be retrieved via \code{residuals(res, track=TRUE)} This tracking functionality is available for all built-in algorithms. } \item{verbose - v}{ Toggle verbosity (default: \code{FALSE}). If \code{TRUE}, messages about the configuration and the state of the current run(s) are displayed. The level of verbosity may be specified with an integer value, the greater the level the more messages are displayed. Value \code{FALSE} means no messages are displayed, while value \code{TRUE} is equivalent to verbosity level 1. } }} \item{.pbackend}{specification of the \code{\link{foreach}} parallel backend to register and/or use when running in parallel mode. See options \code{p} and \code{P} in argument \code{.options} for how to enable this mode. Note that any backend that is internally registered is cleaned-up on exit, so that the calling foreach environment should not be affected by a call to \code{nmf} -- except when \code{.pbackend=NULL}. Currently it accepts the following values: \describe{ \item{\sQuote{par}}{ use the backend(s) defined by the package \code{\link{doParallel}};} \item{a numeric value}{ use the specified number of cores with \code{doParallel} backend;} \item{\sQuote{seq}}{ use the foreach sequential backend \code{doSEQ};} \item{\code{NULL}}{ use currently registered backend;} \item{\code{NA}}{ do not compute using a foreach loop -- and therefore not in parallel -- but rather use a call to standard \code{\link{sapply}}. This is useful for when developing/debugging NMF algorithms, as foreach loop handling may sometime get in the way. Note that this is equivalent to using \code{.options='-p'} or \code{.options='p0'}, but takes precedence over any option specified in \code{.options}: e.g. \code{nmf(..., .options='P10', .pbackend=NA)} performs all runs sequentially using \code{sapply}. Use \code{nmf.options(pbackend=NA)} to completely disable foreach/parallel computations for all subsequent \code{nmf} calls.} \item{\sQuote{mc}}{ identical to \sQuote{par} and defined to ensure backward compatibility.} }} \item{.callback}{Used when option \code{keep.all=FALSE} (default). It allows to pass a callback function that is called after each run when performing multiple runs (i.e. with \code{nrun>1}). This is useful for example if one is also interested in saving summary measures or process the result of each NMF fit before it gets discarded. After each run, the callback function is called with two arguments, the \code{\linkS4class{NMFfit}} object that as just been fitted and the run number: \code{.callback(res, i)}. For convenience, a function that takes only one argument or has signature \code{(x, ...)} can still be passed in \code{.callback}. It is wrapped internally into a dummy function with two arguments, only the first of which is passed to the actual callback function (see example with \code{summary}). The call is wrapped into a tryCatch so that callback errors do not stop the whole computation (see below). The results of the different calls to the callback function are stored in a miscellaneous slot accessible using the method \code{$} for \code{NMFfit} objects: \code{res$.callback}. By default \code{nmf} tries to simplify the list of callback result using \code{sapply}, unless option \code{'simplifyCB'} is \code{FASE}. If no error occurs \code{res$.callback} contains the list of values that resulted from the calling the callback function --, ordered as the fits. If any error occurs in one of the callback calls, then the whole computation is \strong{not} stopped, but the error message is stored in \code{res$.callback}, in place of the result. See the examples for sample code.} } \value{ The returned value depends on the run mode: \item{Single run:}{An object of class \code{\linkS4class{NMFfit}}.} \item{Multiple runs, single method:}{When \code{nrun > 1} and \code{method} is not \code{list}, this method returns an object of class \code{\linkS4class{NMFfitX}}.} \item{Multiple runs, multiple methods:}{When \code{nrun > 1} and \code{method} is a \code{list}, this method returns an object of class \code{\linkS4class{NMFList}}.} } \description{ The function \code{nmf} is a S4 generic defines the main interface to run NMF algorithms within the framework defined in package \code{NMF}. It has many methods that facilitates applying, developing and testing NMF algorithms. The package vignette \code{vignette('NMF')} contains an introduction to the interface, through a sample data analysis. } \details{ The \code{nmf} function has multiple methods that compose a very flexible interface allowing to: \itemize{ \item combine NMF algorithms with seeding methods and/or stopping/convergence criterion at runtime; \item perform multiple NMF runs, which are computed in parallel whenever the host machine allows it; \item run multiple algorithms with a common set of parameters, ensuring a consistent environment (notably the RNG settings). } The workhorse method is \code{nmf,matrix,numeric,NMFStrategy}, which is eventually called by all other methods. The other methods provides convenient ways of specifying the NMF algorithm(s), the factorization rank, or the seed to be used. Some allow to directly run NMF algorithms on different types of objects, such as \code{data.frame} or \code{\link[Biobase]{ExpressionSet}} objects. } \section{Methods}{ \describe{ \item{nmf}{\code{signature(x = "data.frame", rank = "ANY", method = "ANY")}: Fits an NMF model on a \code{data.frame}. The target \code{data.frame} is coerced into a matrix with \code{\link{as.matrix}}. } \item{nmf}{\code{signature(x = "matrix", rank = "numeric", method = "NULL")}: Fits an NMF model using an appropriate algorithm when \code{method} is not supplied. This method tries to select an appropriate algorithm amongst the NMF algorithms stored in the internal algorithm registry, which contains the type of NMF models each algorithm can fit. This is possible when the type of NMF model to fit is available from argument \code{seed}, i.e. if it is an NMF model itself. Otherwise the algorithm to use is obtained from \code{nmf.getOption('default.algorithm')}. This method is provided for internal usage, when called from other \code{nmf} methods with argument \code{method} missing in the top call (e.g. \code{nmf,matrix,numeric,missing}). } \item{nmf}{\code{signature(x = "matrix", rank = "numeric", method = "list")}: Fits multiple NMF models on a common matrix using a list of algorithms. The models are fitted sequentially with \code{nmf} using the same options and parameters for all algorithms. In particular, irrespective of the way the computation is seeded, this method ensures that all fits are performed using the same initial RNG settings. This method returns an object of class \code{\linkS4class{NMFList}}, that is essentially a list containing each fit. } \item{nmf}{\code{signature(x = "matrix", rank = "numeric", method = "character")}: Fits an NMF model on \code{x} using an algorithm registered with access key \code{method}. Argument \code{method} is partially match against the access keys of all registered algorithms (case insensitive). Available algorithms are listed in section \emph{Algorithms} below or the introduction vignette. A vector of their names may be retrieved via \code{nmfAlgorithm()}. } \item{nmf}{\code{signature(x = "matrix", rank = "numeric", method = "function")}: Fits an NMF model on \code{x} using a custom algorithm defined the function \code{method}. The supplied function must have signature \code{(x=matrix, start=NMF, ...)} and return an object that inherits from class \code{\linkS4class{NMF}}. It will be called internally by the workhorse \code{nmf} method, with an NMF model to be used as a starting point passed in its argument \code{start}. Extra arguments in \code{...} are passed to \code{method} from the top \code{nmf} call. Extra arguments that have no default value in the definition of the function \code{method} are required to run the algorithm (e.g. see argument \code{alpha} of \code{myfun} in the examples). If the algorithm requires a specific type of NMF model, this can be specified in argument \code{model} that is handled as in the workhorse \code{nmf} method (see description for this argument). } \item{nmf}{\code{signature(x = "matrix", rank = "NMF", method = "ANY")}: Fits an NMF model using the NMF model \code{rank} to seed the computation, i.e. as a starting point. This method is provided for convenience as a shortcut for \code{nmf(x, nbasis(object), method, seed=object, ...)} It discards any value passed in argument \code{seed} and uses the NMF model passed in \code{rank} instead. It throws a warning if argument \code{seed} not missing. If \code{method} is missing, this method will call the method \code{nmf,matrix,numeric,NULL}, which will infer an algorithm suitable for fitting an NMF model of the class of \code{rank}. } \item{nmf}{\code{signature(x = "matrix", rank = "NULL", method = "ANY")}: Fits an NMF model using the NMF model supplied in \code{seed}, to seed the computation, i.e. as a starting point. This method is provided for completeness and is equivalent to \code{nmf(x, seed, method, ...)}. } \item{nmf}{\code{signature(x = "matrix", rank = "missing", method = "ANY")}: Method defined to ensure the correct dispatch to workhorse methods in case of argument \code{rank} is missing. } \item{nmf}{\code{signature(x = "matrix", rank = "numeric", method = "missing")}: Method defined to ensure the correct dispatch to workhorse methods in case of argument \code{method} is missing. } \item{nmf}{\code{signature(x = "matrix", rank = "matrix", method = "ANY")}: Fits an NMF model partially seeding the computation with a given matrix passed in \code{rank}. The matrix \code{rank} is used either as initial value for the basis or mixture coefficient matrix, depending on its dimension. Currently, such partial NMF model is directly used as a seed, meaning that the remaining part is left uninitialised, which is not accepted by all NMF algorithm. This should change in the future, where the missing part of the model will be drawn from some random distribution. Amongst built-in algorithms, only \sQuote{snmf/l} and \sQuote{snmf/r} support partial seeds, with only the coefficient or basis matrix initialised respectively. } \item{nmf}{\code{signature(x = "matrix", rank = "data.frame", method = "ANY")}: Shortcut for \code{nmf(x, as.matrix(rank), method, ...)}. } \item{nmf}{\code{signature(x = "formula", rank = "ANY", method = "ANY")}: This method implements the interface for fitting formula-based NMF models. See \code{\link{nmfModel}}. Argument \code{rank} target matrix or formula environment. If not missing, \code{model} must be a \code{list}, a \code{data.frame} or an \code{environment} in which formula variables are searched for. } } } \section{Optimized C++ vs. plain R}{ Lee and Seung's multiplicative updates are used by several NMF algorithms. To improve speed and memory usage, a C++ implementation of the specific matrix products is used whenever possible. It directly computes the updates for each entry in the updated matrix, instead of using multiple standard matrix multiplication. The algorithms that benefit from this optimization are: 'brunet', 'lee', 'nsNMF' and 'offset'. % and 'lnmf' However there still exists plain R versions for these methods, which implement the updates as standard matrix products. These are accessible by adding the prefix '.R#' to their name: '.R#brunet', '.R#lee', '.R#nsNMF' and '.R#offset'. } \section{Algorithms}{ All algorithms are accessible by their respective access key as listed below. The following algorithms are available: \describe{ \item{\sQuote{brunet}}{ Standard NMF, based on the Kullback-Leibler divergence, from \cite{Brunet et al. (2004)}. It uses simple multiplicative updates from \cite{Lee et al. (2001)}, enhanced to avoid numerical underflow. Default stopping criterion: invariance of the connectivity matrix (see \code{\link{nmf.stop.connectivity}}). } \item{\sQuote{lee}}{ Standard NMF based on the Euclidean distance from \cite{Lee et al. (2001)}. It uses simple multiplicative updates. Default stopping criterion: invariance of the connectivity matrix (see \code{\link{nmf.stop.connectivity}}). } \item{ls-nmf}{ Least-Square NMF from \cite{Wang et al. (2006)}. It uses modified versions of Lee and Seung's multiplicative updates for the Euclidean distance, which incorporates weights on each entry of the target matrix, e.g. to reflect measurement uncertainty. Default stopping criterion: stationarity of the objective function (see \code{\link{nmf.stop.stationary}}). } \item{\sQuote{nsNMF}}{ Nonsmooth NMF from \cite{Pascual-Montano et al. (2006)}. It uses a modified version of Lee and Seung's multiplicative updates for the Kullback-Leibler divergence \cite{Lee et al. (2001)}, to fit a extension of the standard NMF model, that includes an intermediate smoothing matrix, meant meant to produce sparser factors. Default stopping criterion: invariance of the connectivity matrix (see \code{\link{nmf.stop.connectivity}}). } \item{\sQuote{offset}}{ NMF with offset from \cite{Badea (2008)}. It uses a modified version of Lee and Seung's multiplicative updates for Euclidean distance \cite{Lee et al. (2001)}, to fit an NMF model that includes an intercept, meant to capture a common baseline and shared patterns, in order to produce cleaner basis components. Default stopping criterion: invariance of the connectivity matrix (see \code{\link{nmf.stop.connectivity}}). } \item{\sQuote{pe-nmf}}{ Pattern-Expression NMF from \emph{Zhang2008}. It uses multiplicative updates to minimize an objective function based on the Euclidean distance, that is regularized for effective expression of patterns with basis vectors. Default stopping criterion: stationarity of the objective function (see \code{\link{nmf.stop.stationary}}). } \item{\sQuote{snmf/r}, \sQuote{snmf/l}}{ Alternating Least Square (ALS) approach from \cite{Kim et al. (2007)}. It applies the nonnegative least-squares algorithm from \cite{Van Benthem et al. (2004)} (i.e. fast combinatorial nonnegative least-squares for multiple right-hand), to estimate the basis and coefficient matrices alternatively (see \code{\link{fcnnls}}). It minimises an Euclidean-based objective function, that is regularized to favour sparse basis matrices (for \sQuote{snmf/l}) or sparse coefficient matrices (for \sQuote{snmf/r}). Stopping criterion: built-in within the internal workhorse function \code{nmf_snmf}, based on the KKT optimality conditions. } } } \section{Seeding methods}{ The purpose of seeding methods is to compute initial values for the factor matrices in a given NMF model. This initial guess will be used as a starting point by the chosen NMF algorithm. The seeding method to use in combination with the algorithm can be passed to interface \code{nmf} through argument \code{seed}. The seeding seeding methods available in registry are listed by the function \code{\link{nmfSeed}} (see list therein). Detailed examples of how to specify the seeding method and its parameters can be found in the \emph{Examples} section of this man page and in the package's vignette. } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # Only basic calls are presented in this manpage. # Many more examples are provided in the demo file nmf.R \dontrun{ demo('nmf') } # random data x <- rmatrix(20,10) # run default algorithm with rank 2 res <- nmf(x, 2) # specify the algorithm res <- nmf(x, 2, 'lee') # get verbose message on what is going on res <- nmf(x, 2, .options='v') \dontrun{ # more messages res <- nmf(x, 2, .options='v2') # even more res <- nmf(x, 2, .options='v3') # and so on ... } } \references{ Brunet J, Tamayo P, Golub TR and Mesirov JP (2004). "Metagenes and molecular pattern discovery using matrix factorization." _Proceedings of the National Academy of Sciences of the United States of America_, *101*(12), pp. 4164-9. ISSN 0027-8424, , . Lee DD and Seung H (2001). "Algorithms for non-negative matrix factorization." _Advances in neural information processing systems_. . Wang G, Kossenkov AV and Ochs MF (2006). "LS-NMF: a modified non-negative matrix factorization algorithm utilizing uncertainty estimates." _BMC bioinformatics_, *7*, pp. 175. ISSN 1471-2105, , . Pascual-Montano A, Carazo JM, Kochi K, Lehmann D and Pascual-marqui RD (2006). "Nonsmooth nonnegative matrix factorization (nsNMF)." _IEEE Trans. Pattern Anal. Mach. Intell_, *28*, pp. 403-415. Badea L (2008). "Extracting gene expression profiles common to colon and pancreatic adenocarcinoma using simultaneous nonnegative matrix factorization." _Pacific Symposium on Biocomputing. Pacific Symposium on Biocomputing_, *290*, pp. 267-78. ISSN 1793-5091, . Kim H and Park H (2007). "Sparse non-negative matrix factorizations via alternating non-negativity-constrained least squares for microarray data analysis." _Bioinformatics (Oxford, England)_, *23*(12), pp. 1495-502. ISSN 1460-2059, , . Van Benthem M and Keenan MR (2004). "Fast algorithm for the solution of large-scale non-negativity-constrained least squares problems." _Journal of Chemometrics_, *18*(10), pp. 441-450. ISSN 0886-9383, , . } \seealso{ \code{\link{nmfAlgorithm}} } \keyword{methods} NMF/man/types.Rd0000644000176000001440000001032512305630424013130 0ustar ripleyusers\name{is.nmf} \alias{hasBasis} \alias{hasCoef} \alias{is.empty.nmf} \alias{is.nmf} \alias{isNMFfit} \alias{is.partial.nmf} \title{Testing NMF Objects} \usage{ is.nmf(x) is.empty.nmf(x, ...) hasBasis(x) hasCoef(x) is.partial.nmf(x) isNMFfit(object, recursive = TRUE) } \arguments{ \item{x}{an R object. See section \emph{Details}, for how each function uses this argument.} \item{...}{extra parameters to allow extension or passed to subsequent calls} \item{object}{any R object.} \item{recursive}{if \code{TRUE} and \code{object} is a plain list then \code{isNMFfit} tests each element of the list. Note that the recursive test only applies in the case of lists that are not themselves NMFfit objects, like \code{NMFfitXn} objects for which the result of \code{isNMFfit} will always be \code{TRUE}, although they are list objects (a single logical value).} } \value{ \code{isNMFfit} returns a \code{logical} vector (or a list if \code{object} is a list of list) of the same length as \code{object}. } \description{ The functions documented here tests different characteristics of NMF objects. \code{is.nmf} tests if an object is an NMF model or a class that extends the class NMF. \code{hasBasis} tests whether an objects contains a basis matrix -- returned by a suitable method \code{basis} -- with at least one row. \code{hasBasis} tests whether an objects contains a coefficient matrix -- returned by a suitable method \code{coef} -- with at least one column. \code{is.partial.nmf} tests whether an NMF model object contains either an empty basis or coefficient matrix. It is a shorcut for \code{!hasCoef(x) || !hasBasis(x)}. } \details{ \code{is.nmf} tests if \code{object} is the name of a class (if a \code{character} string), or inherits from a class, that extends \code{\linkS4class{NMF}}. \code{is.empty.nmf} returns \code{TRUE} if the basis and coefficient matrices of \code{x} have respectively zero rows and zero columns. It returns \code{FALSE} otherwise. In particular, this means that an empty model can still have a non-zero number of basis components, i.e. a factorization rank that is not null. This happens, for example, in the case of NMF models created calling the factory method \code{\link{nmfModel}} with a value only for the factorization rank. \emph{isNMFfit} checks if \code{object} inherits from class \code{\linkS4class{NMFfit}} or \code{\linkS4class{NMFfitX}}, which are the two types of objects returned by the function \code{\link{nmf}}. If \code{object} is a plain \code{list} and \code{recursive=TRUE}, then the test is performed on each element of the list, and the return value is a logical vector (or a list if \code{object} is a list of list) of the same length as \code{object}. } \note{ The function \code{is.nmf} does some extra work with the namespace as this function needs to return correct results even when called in \code{.onLoad}. See discussion on r-devel: \url{https://stat.ethz.ch/pipermail/r-devel/2011-June/061357.html} } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } #---------- # is.nmf #---------- # test if an object is an NMF model, i.e. that it implements the NMF interface is.nmf(1:4) is.nmf('NMFstd') is.nmf('NMFblah') is.nmf( nmfModel(3) ) is.nmf( nmf(rmatrix(20,10), 3) ) #---------- # is.empty.nmf #---------- # empty model is.empty.nmf( nmfModel(3) ) # non empty models is.empty.nmf( nmfModel(3, 10, 0) ) is.empty.nmf( rnmf(3, 10, 5) ) #---------- # isNMFfit #---------- ## Testing results of fits # generate a random V <- rmatrix(20, 10) # single run -- using very low value for maxIter to speed up the example res <- nmf(V, 3, maxIter=3L) isNMFfit(res) # multiple runs - keeping single fit resm <- nmf(V, 3, nrun=3, maxIter=3L) isNMFfit(resm) # multiple runs - keeping all fits resM <- nmf(V, 3, nrun=3, .opt='k', maxIter=3L) isNMFfit(resM) # with a list of results isNMFfit(list(res, resm, resM, 'not a result')) isNMFfit(list(res, list(resm, resM), 'not a result')) # list of list isNMFfit(list(res, resm, resM, 'not a result'), recursive=FALSE) } \seealso{ \code{\linkS4class{NMFfit}}, \code{\linkS4class{NMFfitX}}, \code{\linkS4class{NMFfitXn}} } NMF/man/setNMFMethod.Rd0000644000176000001440000000310012305630424014252 0ustar ripleyusers\name{setNMFMethod} \alias{nmfRegisterAlgorithm} \alias{setNMFMethod} \title{Registering NMF Algorithms} \usage{ setNMFMethod(name, method, ..., overwrite = isLoadingNamespace(), verbose = TRUE) nmfRegisterAlgorithm(name, method, ..., overwrite = isLoadingNamespace(), verbose = TRUE) } \arguments{ \item{...}{arguments passed to the factory function \code{\link{NMFStrategy}}, which instantiate the \code{\linkS4class{NMFStrategy}} object that is stored in registry.} \item{overwrite}{logical that indicates if any existing NMF method with the same name should be overwritten (\code{TRUE}) or not (\code{FALSE}), in which case an error is thrown.} \item{verbose}{a logical that indicates if information about the registration should be printed (\code{TRUE}) or not (\code{FALSE}).} \item{name}{name/key of an NMF algorithm.} \item{method}{definition of the algorithm} } \description{ Adds a new algorithm to the registry of algorithms that perform Nonnegative Matrix Factorization. \code{nmfRegisterAlgorithm} is an alias to \code{setNMFMethod} for backward compatibility. } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # define/regsiter a new -- dummy -- NMF algorithm with the minimum arguments # y: target matrix # x: initial NMF model (i.e. the seed) # NB: this algorithm simply return the seed unchanged setNMFMethod('mynmf', function(y, x, ...){ x }) # check algorithm on toy data res <- nmfCheck('mynmf') # the NMF seed is not changed stopifnot( nmf.equal(res, nmfCheck('mynmf', seed=res)) ) } NMF/man/NMFList-class.Rd0000644000176000001440000000244112234465004014344 0ustar ripleyusers\docType{class} \name{NMFList-class} \alias{NMFList-class} \title{Class for Storing Heterogeneous NMF fits} \description{ This class wraps a list of NMF fit objects, which may come from different runs of the function \code{\link{nmf}}, using different parameters, methods, etc.. These can be either from a single run (NMFfit) or multiple runs (NMFfitX). Note that its definition/interface is very likely to change in the future. } \section{Methods}{ \describe{ \item{algorithm}{\code{signature(object = "NMFList")}: Returns the method names used to compute the NMF fits in the list. It returns \code{NULL} if the list is empty. } \item{runtime}{\code{signature(object = "NMFList")}: Returns the CPU time required to compute all NMF fits in the list. It returns \code{NULL} if the list is empty. If no timing data are available, the sequential time is returned. } \item{seqtime}{\code{signature(object = "NMFList")}: Returns the CPU time that would be required to sequentially compute all NMF fits stored in \code{object}. This method calls the function \code{runtime} on each fit and sum up the results. It returns \code{NULL} on an empty object. } \item{show}{\code{signature(object = "NMFList")}: Show method for objects of class \code{NMFList} } } } NMF/man/nmf.equal.Rd0000644000176000001440000000774312234465004013665 0ustar ripleyusers\docType{methods} \name{nmf.equal} \alias{nmf.equal} \alias{nmf.equal,list,list-method} \alias{nmf.equal,list,missing-method} \alias{nmf.equal-methods} \alias{nmf.equal,NMFfit,NMFfit-method} \alias{nmf.equal,NMFfit,NMF-method} \alias{nmf.equal,NMFfitX1,NMFfitX1-method} \alias{nmf.equal,NMFfitX,NMF-method} \alias{nmf.equal,NMF,NMFfit-method} \alias{nmf.equal,NMF,NMFfitX-method} \alias{nmf.equal,NMF,NMF-method} \title{Testing Equality of NMF Models} \usage{ nmf.equal(x, y, ...) \S4method{nmf.equal}{NMF,NMF}(x, y, identical = TRUE, ...) \S4method{nmf.equal}{list,list}(x, y, ..., all = FALSE, vector = FALSE) } \arguments{ \item{x}{an NMF model or an object that is associated with an NMF model, e.g. the result from a fit with \code{\link{nmf}}.} \item{y}{an NMF model or an object that is associated with an NMF model, e.g. the result from a fit with \code{\link{nmf}}.} \item{identical}{a logical that indicates if the comparison should be made using the function \code{\link{identical}} (\code{TRUE}) or \code{\link{all.equal}} (\code{FALSE}). See description for method \code{nmf.equal,NMF,NMF}.} \item{...}{extra arguments to allow extension, and passed to subsequent calls} \item{all}{a logical that indicates if all fits should be compared separately or only the best fits} \item{vector}{a logical, only used when \code{all=TRUE}, that indicates if all fits must be equal for \code{x} and \code{y} to be declared equal, or if one wants to return the result of each comparison in a vector.} } \description{ The function \code{nmf.equal} tests if two NMF models are the same, i.e. they contain -- almost -- identical data: same basis and coefficient matrices, as well as same extra parameters. } \details{ \code{nmf.equal} compares two NMF models, and return \code{TRUE} iff they are identical acording to the function \code{\link{identical}} when \code{identical=TRUE}, or equal up to some tolerance acording to the function \code{\link{all.equal}}. This means that all data contained in the objects are compared, which includes at least the basis and coefficient matrices, as well as the extra parameters stored in slot \sQuote{misc}. If extra arguments are specified in \code{...}, then the comparison is performed using \code{\link{all.equal}}, irrespective of the value of argument \code{identical}. } \section{Methods}{ \describe{ \item{nmf.equal}{\code{signature(x = "NMF", y = "NMF")}: Compares two NMF models. Arguments in \code{...} are used only when \code{identical=FALSE} and are passed to \code{all.equal}. } \item{nmf.equal}{\code{signature(x = "NMFfit", y = "NMF")}: Compares two NMF models when at least one comes from a NMFfit object, i.e. an object returned by a single run of \code{\link{nmf}}. } \item{nmf.equal}{\code{signature(x = "NMF", y = "NMFfit")}: Compares two NMF models when at least one comes from a NMFfit object, i.e. an object returned by a single run of \code{\link{nmf}}. } \item{nmf.equal}{\code{signature(x = "NMFfit", y = "NMFfit")}: Compares two fitted NMF models, i.e. objects returned by single runs of \code{\link{nmf}}. } \item{nmf.equal}{\code{signature(x = "NMFfitX", y = "NMF")}: Compares two NMF models when at least one comes from multiple NMF runs. } \item{nmf.equal}{\code{signature(x = "NMF", y = "NMFfitX")}: Compares two NMF models when at least one comes from multiple NMF runs. } \item{nmf.equal}{\code{signature(x = "NMFfitX1", y = "NMFfitX1")}: Compares the NMF models fitted by multiple runs, that only kept the best fits. } \item{nmf.equal}{\code{signature(x = "list", y = "list")}: Compares the results of multiple NMF runs. This method either compare the two best fit, or all fits separately. All extra arguments in \code{...} are passed to each internal call to \code{nmf.equal}. } \item{nmf.equal}{\code{signature(x = "list", y = "missing")}: Compare all elements in \code{x} to \code{x[[1]]}. } } } \keyword{methods} NMF/man/terms-internal.Rd0000644000176000001440000000226712234470405014740 0ustar ripleyusers\docType{methods} \name{bterms<-} \alias{bterms<-} \alias{bterms<--methods} \alias{bterms<-,NMFstd-method} \alias{cterms<-} \alias{cterms<--methods} \alias{cterms<-,NMFstd-method} \title{Fixed Terms in NMF Models} \usage{ bterms(object)<-value cterms(object)<-value } \arguments{ \item{object}{NMF object to be updated.} \item{value}{specification of the replacement value for fixed-terms.} } \description{ These functions are for internal use and should not be called by the end-user. \code{cterms<-} sets fixed coefficient terms or indexes and should only be called on a newly created NMF object, i.e. in the constructor/factory generic \code{\link{nmfModel}}. } \details{ They use \code{\link{model.matrix}(~ -1 + ., data=value)} to generate suitable term matrices. } \section{Methods}{ \describe{ \item{bterms<-}{\code{signature(object = "NMFstd")}: Default method tries to coerce \code{value} into a \code{data.frame} with \code{\link{as.data.frame}}. } \item{cterms<-}{\code{signature(object = "NMFstd")}: Default method tries to coerce \code{value} into a \code{data.frame} with \code{\link{as.data.frame}}. } } } \keyword{internal} \keyword{methods} NMF/man/lsNMF-nmf.Rd0000644000176000001440000000566612305630424013535 0ustar ripleyusers\name{nmf_update.lsnmf} \alias{lsNMF-nmf} \alias{nmfAlgorithm.lsNMF} \alias{nmf_update.lsnmf} \alias{wrss} \title{Multiplicative Updates for LS-NMF} \usage{ nmf_update.lsnmf(i, X, object, weight, eps = 10^-9, ...) wrss(object, X, weight) nmfAlgorithm.lsNMF(..., .stop = NULL, maxIter = nmf.getOption("maxIter") \%||\% 2000, weight, eps = 10^-9, stationary.th = .Machine$double.eps, check.interval = 5 * check.niter, check.niter = 10L) } \arguments{ \item{i}{current iteration} \item{X}{target matrix} \item{object}{current NMF model} \item{weight}{value for \eqn{\Sigma}{S}, i.e. the weights that are applied to each entry in \code{X} by \code{X * weight} (= entry wise product). Weights are usually specified as a matrix of the same dimension as \code{X} (e.g. uncertainty estimates for each measurement), but may also be passed as a vector, in which case the standard rules for entry wise product between matrices and vectors apply (e.g. recylcing elements).} \item{eps}{small number passed to the standard euclidean-based NMF updates (see \code{\link{nmf_update.euclidean}}).} \item{...}{extra arguments (not used)} \item{.stop}{specification of a stopping criterion, that is used instead of the one associated to the NMF algorithm. It may be specified as: \itemize{ \item the access key of a registered stopping criterion; \item a single integer that specifies the exact number of iterations to perform, which will be honoured unless a lower value is explicitly passed in argument \code{maxIter}. \item a single numeric value that specifies the stationnarity threshold for the objective function, used in with \code{\link{nmf.stop.stationary}}; \item a function with signature \code{(object="NMFStrategy", i="integer", y="matrix", x="NMF", ...)}, where \code{object} is the \code{NMFStrategy} object that describes the algorithm being run, \code{i} is the current iteration, \code{y} is the target matrix and \code{x} is the current value of the NMF model. }} \item{maxIter}{maximum number of iterations to perform.} \item{stationary.th}{maximum absolute value of the gradient, for the objective function to be considered stationary.} \item{check.interval}{interval (in number of iterations) on which the stopping criterion is computed.} \item{check.niter}{number of successive iteration used to compute the stationnary criterion.} } \value{ updated object \code{object} } \description{ Implementation of the updates for the LS-NMF algorithm from \cite{Wang et al. (2006)}. \code{wrss} implements the objective function used by the LS-NMF algorithm. } \references{ Wang G, Kossenkov AV and Ochs MF (2006). "LS-NMF: a modified non-negative matrix factorization algorithm utilizing uncertainty estimates." _BMC bioinformatics_, *7*, pp. 175. ISSN 1471-2105, , . } NMF/man/deviance.Rd0000644000176000001440000000623612234465004013551 0ustar ripleyusers\docType{methods} \name{deviance} \alias{deviance} \alias{deviance-methods} \alias{deviance,NMFfit-method} \alias{deviance,NMFfitX-method} \alias{deviance,NMF-method} \alias{deviance,NMFStrategy-method} \alias{nmfDistance} \title{Distances and Objective Functions} \usage{ deviance(object, ...) \S4method{deviance}{NMF}(object, y, method = c("", "KL", "euclidean"), ...) nmfDistance(method = c("", "KL", "euclidean")) \S4method{deviance}{NMFfit}(object, y, method, ...) \S4method{deviance}{NMFStrategy}(object, x, y, ...) } \arguments{ \item{y}{a matrix compatible with the NMF model \code{object}, i.e. \code{y} must have the same dimension as \code{fitted(object)}.} \item{method}{a character string or a function with signature \code{(x="NMF", y="matrix", ...)} that implements a distance measure between an NMF model \code{x} and a target matrix \code{y}, i.e. an objective function to use to compute the deviance. In \code{deviance}, it is passed to \code{nmfDistance} to get the function that effectively computes the deviance.} \item{...}{extra parameters passed to the objective function.} \item{x}{an NMF model that estimates \code{y}.} \item{object}{an object for which the deviance is desired.} } \value{ \code{deviance} returns a nonnegative numerical value \code{nmfDistance} returns a function with least two arguments: an NMF model and a matrix. } \description{ The NMF package defines methods for the generic \code{deviance} from the package \code{stats}, to compute approximation errors between NMF models and matrices, using a variety of objective functions. \code{nmfDistance} returns a function that computes the distance between an NMF model and a compatible matrix. } \section{Methods}{ \describe{ \item{deviance}{\code{signature(object = "NMF")}: Computes the distance between a matrix and the estimate of an \code{NMF} model. } \item{deviance}{\code{signature(object = "NMFfit")}: Returns the deviance of a fitted NMF model. This method returns the final residual value if the target matrix \code{y} is not supplied, or the approximation error between the fitted NMF model stored in \code{object} and \code{y}. In this case, the computation is performed using the objective function \code{method} if not missing, or the objective of the algorithm that fitted the model (stored in slot \code{'distance'}). If not computed by the NMF algorithm itself, the value is automatically computed at the end of the fitting process by the function \code{\link{nmf}}, using the objective function associated with the NMF algorithm, so that it should always be available. } \item{deviance}{\code{signature(object = "NMFfitX")}: Returns the deviance achieved by the best fit object, i.e. the lowest deviance achieved across all NMF runs. } \item{deviance}{\code{signature(object = "NMFStrategy")}: Computes the value of the objective function between the estimate \code{x} and the target \code{y}. } } } \seealso{ Other stats: \code{\link{deviance,NMF-method}}, \code{\link{hasTrack}}, \code{\link{residuals}}, \code{\link{residuals<-}}, \code{\link{trackError}} } \keyword{methods} NMF/man/offset-commaNMFOffset-method.Rd0000644000176000001440000000062612234465004017336 0ustar ripleyusers\docType{methods} \name{offset,NMFOffset-method} \alias{offset,NMFOffset-method} \title{Offsets in NMF Models with Offset} \usage{ \S4method{offset}{NMFOffset}(object) } \arguments{ \item{object}{an instance of class \code{NMFOffset}.} } \description{ The function \code{offset} returns the offset vector from an NMF model that has an offset, e.g. an \code{NMFOffset} model. } \keyword{methods} NMF/man/residuals.Rd0000644000176000001440000000633312234470405013765 0ustar ripleyusers\docType{methods} \name{residuals} \alias{hasTrack} \alias{residuals} \alias{residuals<-} \alias{residuals<--methods} \alias{residuals-methods} \alias{residuals<-,NMFfit-method} \alias{residuals,NMFfit-method} \alias{residuals,NMFfitX-method} \alias{trackError} \title{Residuals in NMF Models} \usage{ residuals(object, ...) \S4method{residuals}{NMFfit}(object, track = FALSE, niter = NULL, ...) residuals(object, ...)<-value \S4method{residuals}{NMFfit}(object, ..., niter = NULL, track = FALSE)<-value hasTrack(object, niter = NULL) trackError(object, value, niter, force = FALSE) } \arguments{ \item{object}{an \code{NMFfit} object as fitted by function \code{\link{nmf}}, in single run mode.} \item{...}{extra parameters (not used)} \item{track}{a logical that indicates if the complete track of residuals should be returned (if it has been computed during the fit), or only the last value.} \item{niter}{specifies the iteration number for which one wants to get/set/test a residual value. This argument is used only if not \code{NULL}} \item{value}{residual value} \item{force}{logical that indicates if the value should be added to the track even if there already is a value for this iteration number or if the iteration does not conform to the tracking interval \code{nmf.getOption('track.interval')}.} } \value{ \code{residuals} returns a single numeric value if \code{track=FALSE} or a numeric vector containing the residual values at some iterations. The names correspond to the iterations at which the residuals were computed. } \description{ The package NMF defines methods for the function \code{\link[stats]{residuals}} that returns the final residuals of an NMF fit or the track of the residuals along the fit process, computed according to the objective function associated with the algorithm that fitted the model. \code{residuals<-} sets the value of the last residuals, or, optionally, of the complete residual track. Tells if an \code{NMFfit} object contains a recorded residual track. \code{trackError} adds a residual value to the track of residuals. } \details{ When called with \code{track=TRUE}, the whole residuals track is returned, if available. Note that method \code{\link{nmf}} does not compute the residuals track, unless explicitly required. It is a S4 methods defined for the associated generic functions from package \code{stats} (See \link[stats]{residuals}). } \note{ Stricly speaking, the method \code{residuals,NMFfit} does not fulfill its contract as defined by the package \code{stats}, but rather acts as function \code{deviance}. The might be changed in a later release to make it behave as it should. } \section{Methods}{ \describe{ \item{residuals}{\code{signature(object = "NMFfit")}: Returns the residuals -- track -- between the target matrix and the NMF fit \code{object}. } \item{residuals}{\code{signature(object = "NMFfitX")}: Returns the residuals achieved by the best fit object, i.e. the lowest residual approximation error achieved across all NMF runs. } } } \seealso{ Other stats: \code{\link{deviance}}, \code{\link{deviance,NMF-method}}, \code{\link{nmfDistance}} } \keyword{methods} NMF/man/NMFfitXn-class.Rd0000644000176000001440000001376012305630424014526 0ustar ripleyusers\docType{class} \name{NMFfitXn-class} \alias{NMFfitXn-class} \title{Structure for Storing All Fits from Multiple NMF Runs} \description{ This class is used to return the result from a multiple run of a single NMF algorithm performed with function \code{nmf} with option \code{keep.all=TRUE} (cf. \code{\link{nmf}}). } \details{ It extends both classes \code{\linkS4class{NMFfitX}} and \code{list}, and stores the result of each run (i.e. a \code{NMFfit} object) in its \code{list} structure. IMPORTANT NOTE: This class is designed to be \strong{read-only}, even though all the \code{list}-methods can be used on its instances. Adding or removing elements would most probably lead to incorrect results in subsequent calls. Capability for concatenating and merging NMF results is for the moment only used internally, and should be included and supported in the next release of the package. } \section{Slots}{ \describe{ \item{.Data}{standard slot that contains the S3 \code{list} object data. See R documentation on S3/S4 classes for more details (e.g., \code{\link{setOldClass}}).} } } \section{Methods}{ \describe{ \item{algorithm}{\code{signature(object = "NMFfitXn")}: Returns the name of the common NMF algorithm used to compute all fits stored in \code{object} Since all fits are computed with the same algorithm, this method returns the name of algorithm that computed the first fit. It returns \code{NULL} if the object is empty. } \item{basis}{\code{signature(object = "NMFfitXn")}: Returns the basis matrix of the best fit amongst all the fits stored in \code{object}. It is a shortcut for \code{basis(fit(object))}. } \item{coef}{\code{signature(object = "NMFfitXn")}: Returns the coefficient matrix of the best fit amongst all the fits stored in \code{object}. It is a shortcut for \code{coef(fit(object))}. } \item{compare}{\code{signature(object = "NMFfitXn")}: Compares the fits obtained by separate runs of NMF, in a single call to \code{\link{nmf}}. } \item{consensus}{\code{signature(object = "NMFfitXn")}: This method returns \code{NULL} on an empty object. The result is a matrix with several attributes attached, that are used by plotting functions such as \code{\link{consensusmap}} to annotate the plots. } \item{dim}{\code{signature(x = "NMFfitXn")}: Returns the dimension common to all fits. Since all fits have the same dimensions, it returns the dimension of the first fit. This method returns \code{NULL} if the object is empty. } \item{entropy}{\code{signature(x = "NMFfitXn", y = "ANY")}: Computes the best or mean entropy across all NMF fits stored in \code{x}. } \item{fit}{\code{signature(object = "NMFfitXn")}: Returns the best NMF fit object amongst all the fits stored in \code{object}, i.e. the fit that achieves the lowest estimation residuals. } \item{.getRNG}{\code{signature(object = "NMFfitXn")}: Returns the RNG settings used for the best fit. This method throws an error if the object is empty. } \item{getRNG1}{\code{signature(object = "NMFfitXn")}: Returns the RNG settings used for the first run. This method throws an error if the object is empty. } \item{minfit}{\code{signature(object = "NMFfitXn")}: Returns the best NMF model in the list, i.e. the run that achieved the lower estimation residuals. The model is selected based on its \code{deviance} value. } \item{modelname}{\code{signature(object = "NMFfitXn")}: Returns the common type NMF model of all fits stored in \code{object} Since all fits are from the same NMF model, this method returns the model type of the first fit. It returns \code{NULL} if the object is empty. } \item{nbasis}{\code{signature(x = "NMFfitXn")}: Returns the number of basis components common to all fits. Since all fits have been computed using the same rank, it returns the factorization rank of the first fit. This method returns \code{NULL} if the object is empty. } \item{nrun}{\code{signature(object = "NMFfitXn")}: Returns the number of runs performed to compute the fits stored in the list (i.e. the length of the list itself). } \item{purity}{\code{signature(x = "NMFfitXn", y = "ANY")}: Computes the best or mean purity across all NMF fits stored in \code{x}. } \item{runtime.all}{\code{signature(object = "NMFfitXn")}: If no time data is available from in slot \sQuote{runtime.all} and argument \code{null=TRUE}, then the sequential time as computed by \code{\link{seqtime}} is returned, and a warning is thrown unless \code{warning=FALSE}. } \item{seeding}{\code{signature(object = "NMFfitXn")}: Returns the name of the common seeding method used the computation of all fits stored in \code{object} Since all fits are seeded using the same method, this method returns the name of the seeding method used for the first fit. It returns \code{NULL} if the object is empty. } \item{seqtime}{\code{signature(object = "NMFfitXn")}: Returns the CPU time that would be required to sequentially compute all NMF fits stored in \code{object}. This method calls the function \code{runtime} on each fit and sum up the results. It returns \code{NULL} on an empty object. } \item{show}{\code{signature(object = "NMFfitXn")}: Show method for objects of class \code{NMFfitXn} } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # generate a synthetic dataset with known classes n <- 20; counts <- c(5, 2, 3); V <- syntheticNMF(n, counts) # get the class factor groups <- V$pData$Group # perform multiple runs of one algorithm, keeping all the fits res <- nmf(V, 3, nrun=3, .options='k') # .options=list(keep.all=TRUE) also works res summary(res) # get more info summary(res, target=V, class=groups) # compute/show computational times runtime.all(res) seqtime(res) # plot the consensus matrix, computed on the fly \dontrun{ consensusmap(res, annCol=groups) } } \seealso{ Other multipleNMF: \code{\link{NMFfitX1-class}}, \code{\link{NMFfitX-class}} } NMF/man/NMFstd-class.Rd0000644000176000001440000001437112305630424014227 0ustar ripleyusers\docType{class} \name{NMFstd-class} \alias{NMFstd-class} \title{NMF Model - Standard model} \description{ This class implements the standard model of Nonnegative Matrix Factorization. It provides a general structure and generic functions to manage factorizations that follow the standard NMF model, as defined by \cite{Lee et al. (2001)}. } \details{ Let \eqn{V} be a \eqn{n \times m} non-negative matrix and \eqn{r} a positive integer. In its standard form (see references below), a NMF of \eqn{V} is commonly defined as a pair of matrices \eqn{(W, H)} such that: \deqn{V \equiv W H,} where: \itemize{ \item \eqn{W} and \eqn{H} are \eqn{n \times r} and \eqn{r \times m} matrices respectively with non-negative entries; \item \eqn{\equiv} is to be understood with respect to some loss function. Common choices of loss functions are based on Frobenius norm or Kullback-Leibler divergence. } Integer \eqn{r} is called the \emph{factorization rank}. Depending on the context of application of NMF, the columns of \eqn{W} and \eqn{H} are given different names: \describe{ \item{columns of \code{W}}{basis vector, metagenes, factors, source, image basis} \item{columns of \code{H}}{mixture coefficients, metagene sample expression profiles, weights} \item{rows of \code{H}}{basis profiles, metagene expression profiles} } NMF approaches have been successfully applied to several fields. The package NMF was implemented trying to use names as generic as possible for objects and methods. The following terminology is used: \describe{ \item{samples}{the columns of the target matrix \eqn{V}} \item{features}{the rows of the target matrix \eqn{V}} \item{basis matrix}{the first matrix factor \eqn{W}} \item{basis vectors}{the columns of first matrix factor \eqn{W}} \item{mixture matrix}{the second matrix factor \eqn{H}} \item{mixtures coefficients}{the columns of second matrix factor \eqn{H}} } However, because the package NMF was primarily implemented to work with gene expression microarray data, it also provides a layer to easily and intuitively work with objects from the Bioconductor base framework. See \link{bioc-NMF} for more details. } \section{Slots}{ \describe{ \item{W}{A \code{matrix} that contains the basis matrix, i.e. the \emph{first} matrix factor of the factorisation} \item{H}{A \code{matrix} that contains the coefficient matrix, i.e. the \emph{second} matrix factor of the factorisation} \item{bterms}{a \code{data.frame} that contains the primary data that define fixed basis terms. See \code{\link{bterms}}.} \item{ibterms}{integer vector that contains the indexes of the basis components that are fixed, i.e. for which only the coefficient are estimated. IMPORTANT: This slot is set on construction of an NMF model via \code{\link[=nmfModel,formula,ANY-method]{nmfModel}} and is not recommended to not be subsequently changed by the end-user.} \item{cterms}{a \code{data.frame} that contains the primary data that define fixed coefficient terms. See \code{\link{cterms}}.} \item{icterms}{integer vector that contains the indexes of the basis components that have fixed coefficients, i.e. for which only the basis vectors are estimated. IMPORTANT: This slot is set on construction of an NMF model via \code{\link[=nmfModel,formula,ANY-method]{nmfModel}} and is not recommended to not be subsequently changed by the end-user.} } } \section{Methods}{ \describe{ \item{.basis}{\code{signature(object = "NMFstd")}: Get the basis matrix in standard NMF models This function returns slot \code{W} of \code{object}. } \item{.basis<-}{\code{signature(object = "NMFstd", value = "matrix")}: Set the basis matrix in standard NMF models This function sets slot \code{W} of \code{object}. } \item{bterms<-}{\code{signature(object = "NMFstd")}: Default method tries to coerce \code{value} into a \code{data.frame} with \code{\link{as.data.frame}}. } \item{.coef}{\code{signature(object = "NMFstd")}: Get the mixture coefficient matrix in standard NMF models This function returns slot \code{H} of \code{object}. } \item{.coef<-}{\code{signature(object = "NMFstd", value = "matrix")}: Set the mixture coefficient matrix in standard NMF models This function sets slot \code{H} of \code{object}. } \item{cterms<-}{\code{signature(object = "NMFstd")}: Default method tries to coerce \code{value} into a \code{data.frame} with \code{\link{as.data.frame}}. } \item{fitted}{\code{signature(object = "NMFstd")}: Compute the target matrix estimate in \emph{standard NMF models}. The estimate matrix is computed as the product of the two matrix slots \code{W} and \code{H}: \deqn{\hat{V} = W H}{V ~ W H} } \item{ibterms}{\code{signature(object = "NMFstd")}: Method for standard NMF models, which returns the integer vector that is stored in slot \code{ibterms} when a formula-based NMF model is instantiated. } \item{icterms}{\code{signature(object = "NMFstd")}: Method for standard NMF models, which returns the integer vector that is stored in slot \code{icterms} when a formula-based NMF model is instantiated. } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # create a completely empty NMFstd object new('NMFstd') # create a NMF object based on one random matrix: the missing matrix is deduced # Note this only works when using factory method NMF n <- 50; r <- 3; w <- rmatrix(n, r) nmfModel(W=w) # create a NMF object based on random (compatible) matrices p <- 20 h <- rmatrix(r, p) nmfModel(W=w, H=h) # create a NMF object based on incompatible matrices: generate an error h <- rmatrix(r+1, p) try( new('NMFstd', W=w, H=h) ) try( nmfModel(w, h) ) # Giving target dimensions to the factory method allow for coping with dimension # incompatibilty (a warning is thrown in such case) nmfModel(r, W=w, H=h) } \references{ Lee DD and Seung H (2001). "Algorithms for non-negative matrix factorization." _Advances in neural information processing systems_. . } \seealso{ Other NMF-model: \code{\link{initialize,NMFOffset-method}}, \code{\link{NMFns-class}}, \code{\link{NMFOffset-class}} } NMF/man/checkErrors.Rd0000644000176000001440000000050512234465004014236 0ustar ripleyusers\name{checkErrors} \alias{checkErrors} \title{Error Checks in NMF Runs} \usage{ checkErrors(object, element = NULL) } \arguments{ \item{object}{a list of lists} \item{element}{name of an element of the inner lists} } \description{ Auxiliary function for internal error checks in nmf results. } \keyword{internal} NMF/man/nmfWrapper.Rd0000644000176000001440000000371612305630424014113 0ustar ripleyusers\name{nmfWrapper} \alias{nmfWrapper} \title{Wrapping NMF Algorithms} \usage{ nmfWrapper(method, ..., .FIXED = FALSE) } \arguments{ \item{method}{Name of the NMF algorithm to be wrapped. It should be the name of a registered algorithm as returned by \code{\link{nmfAlgorithm}}, or an NMF algorithm object (i.e. an instance of \code{\linkS4class{NMFStrategy}}).} \item{...}{extra named arguments that define default values for any arguments of \code{\link{nmf}} or the algorithm itself.} \item{.FIXED}{a logical that indicates if the default arguments defined in \code{...} must be considered as fixed, i.e. that they are forced to have the defined values and cannot be used in a call to the wrapper function, in which case, a warning about discarding them is thrown if they are used. Non fixed arguments may have their value changed at call time, in which case it is honoured and passed to the \code{nmf} call. \code{.FIXED} may also be a character vector that specifies which argument amongst \code{...} should be considered as fixed.} } \value{ a function with argument \code{...} and a set of default arguments defined in \code{...} in the call to \code{nmfWrapper}. } \description{ This function creates a wrapper function for calling the function \code{\link{nmf}} with a given NMF algorithm. } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # wrap Lee & Seung algorithm into a function lee <- nmfWrapper('lee', seed=12345) args(lee) # test on random data x <- rmatrix(100,20) res <- nmf(x, 3, 'lee', seed=12345) res2 <- lee(x, 3) nmf.equal(res, res2) res3 <- lee(x, 3, seed=123) nmf.equal(res, res3) \dontshow{ stopifnot(nmf.equal(res, res2)) stopifnot( !nmf.equal(res, res3)) } # argument 'method' has no effect res4 <- lee(x, 3, method='brunet') nmf.equal(res, res4) \dontshow{ stopifnot(nmf.equal(res, res4)) } } \seealso{ \code{\link{nmfAlgorithm}}, \code{\link{nmf}} } \keyword{internal} NMF/man/nmfModel.Rd0000644000176000001440000003626512305630424013540 0ustar ripleyusers\docType{methods} \name{nmfModel} \alias{nmfModel} \alias{nmfModel,data.frame,data.frame-method} \alias{nmfModel,formula,ANY-method} \alias{nmfModel,matrix,ANY-method} \alias{nmfModel,matrix,matrix-method} \alias{nmfModel-methods} \alias{nmfModel,missing,ANY-method} \alias{nmfModel,missing,missing-method} \alias{nmfModel,NULL,ANY-method} \alias{nmfModel,numeric,matrix-method} \alias{nmfModel,numeric,missing-method} \alias{nmfModel,numeric,numeric-method} \alias{nmfModels} \title{Factory Methods NMF Models} \usage{ nmfModel(rank, target = 0L, ...) \S4method{nmfModel}{numeric,numeric}(rank, target, ncol = NULL, model = "NMFstd", W, H, ..., force.dim = TRUE, order.basis = TRUE) \S4method{nmfModel}{numeric,matrix}(rank, target, ..., use.names = TRUE) \S4method{nmfModel}{formula,ANY}(rank, target, ..., data = NULL, no.attrib = FALSE) nmfModels(builtin.only = FALSE) } \arguments{ \item{rank}{specification of the target factorization rank (i.e. the number of components).} \item{target}{an object that specifies the dimension of the estimated target matrix.} \item{...}{extra arguments to allow extension, that are passed down to the workhorse method \code{nmfModel,numeric.numeric}, where they are used to initialise slots specific to the instantiating NMF model class.} \item{ncol}{a numeric value that specifies the number of columns of the target matrix, fitted the NMF model. It is used only if not missing and when argument \code{target} is a single numeric value.} \item{model}{the class of the object to be created. It must be a valid class name that inherits from class \code{NMF}. Default is the standard NMF model \code{\linkS4class{NMFstd}}.} \item{W}{value for the basis matrix. \code{data.frame} objects are converted into matrices with \code{\link{as.matrix}}.} \item{H}{value for the mixture coefficient matrix \code{data.frame} objects are converted into matrices with \code{\link{as.matrix}}.} \item{force.dim}{logical that indicates whether the method should try lowering the rank or shrinking dimensions of the input matrices to make them compatible} \item{order.basis}{logical that indicates whether the basis components should reorder the rows of the mixture coefficient matrix to match the order of the basis components, based on their respective names. It is only used if the basis and coefficient matrices have common unique column and row names respectively.} \item{use.names}{a logical that indicates whether the dimension names of the target matrix should be set on the returned NMF model.} \item{data}{Optional argument where to look for the variables used in the formula.} \item{no.attrib}{logical that indicate if attributes containing data related to the formula should be attached as attributes. If \code{FALSE} attributes \code{'target'} and \code{'formula'} contain the target matrix, and a list describing each formula part (response, regressors, etc.).} \item{builtin.only}{logical that indicates whether only built-in NMF models, i.e. defined within the NMF package, should be listed.} } \value{ an object that inherits from class \code{\linkS4class{NMF}}. a list } \description{ \code{nmfModel} is a S4 generic function which provides a convenient way to build NMF models. It implements a unified interface for creating \code{NMF} objects from any NMF models, which is designed to resolve potential dimensions inconsistencies. \code{nmfModels} lists all available NMF models currently defined that can be used to create NMF objects, i.e. -- more or less -- all S4 classes that inherit from class \code{\linkS4class{NMF}}. } \details{ All \code{nmfModel} methods return an object that inherits from class \code{NMF}, that is suitable for seeding NMF algorithms via arguments \code{rank} or \code{seed} of the \code{\link{nmf}} method, in which case the factorisation rank is implicitly set by the number of basis components in the seeding model (see \code{\link{nmf}}). For convenience, shortcut methods and internal conversions for working on \code{data.frame} objects directly are implemented. However, note that conversion of a \code{data.frame} into a \code{matrix} object may take some non-negligible time, for large datasets. If using this method or other NMF-related methods several times, consider converting your data \code{data.frame} object into a matrix once for good, when first loaded. } \section{Methods}{ \describe{ \item{nmfModel}{\code{signature(rank = "numeric", target = "numeric")}: Main factory method for NMF models This method is the workhorse method that is eventually called by all other methods. See section \emph{Main factory method} for more details. } \item{nmfModel}{\code{signature(rank = "numeric", target = "missing")}: Creates an empty NMF model of a given rank. This call is equivalent to \code{nmfModel(rank, 0L, ...)}, which creates \emph{empty} \code{NMF} object with a basis and mixture coefficient matrix of dimension 0 x \code{rank} and \code{rank} x 0 respectively. } \item{nmfModel}{\code{signature(rank = "missing", target = "ANY")}: Creates an empty NMF model of null rank and a given dimension. This call is equivalent to \code{nmfModel(0, target, ...)}. } \item{nmfModel}{\code{signature(rank = "NULL", target = "ANY")}: Creates an empty NMF model of null rank and given dimension. This call is equivalent to \code{nmfModel(0, target, ...)}, and is meant for internal usage only. } \item{nmfModel}{\code{signature(rank = "missing", target = "missing")}: Creates an empty NMF model or from existing factors This method is equivalent to \code{nmfModel(0, 0, ..., force.dim=FALSE)}. This means that the dimensions of the NMF model will be taken from the optional basis and mixture coefficient arguments \code{W} and \code{H}. An error is thrown if their dimensions are not compatible. Hence, this method may be used to generate an NMF model from existing factor matrices, by providing the named arguments \code{W} and/or \code{H}: \code{nmfModel(W=w)} or \code{nmfModel(H=h)} or \code{nmfModel(W=w, H=h)} Note that this may be achieved using the more convenient interface is provided by the method \code{nmfModel,matrix,matrix} (see its dedicated description). See the description of the appropriate method below. } \item{nmfModel}{\code{signature(rank = "numeric", target = "matrix")}: Creates an NMF model compatible with a target matrix. This call is equivalent to \code{nmfModel(rank, dim(target), ...)}. That is that the returned NMF object fits a target matrix of the same dimension as \code{target}. Only the dimensions of \code{target} are used to construct the \code{NMF} object. The matrix slots are filled with \code{NA} values if these are not specified in arguments \code{W} and/or \code{H}. However, dimension names are set on the return NMF model if present in \code{target} and argument \code{use.names=TRUE}. } \item{nmfModel}{\code{signature(rank = "matrix", target = "matrix")}: Creates an NMF model based on two existing factors. This method is equivalent to \code{nmfModel(0, 0, W=rank, H=target..., force.dim=FALSE)}. This allows for a natural shortcut for wrapping existing \strong{compatible} matrices into NMF models: \samp{nmfModel(w, h)} Note that an error is thrown if their dimensions are not compatible. } \item{nmfModel}{\code{signature(rank = "data.frame", target = "data.frame")}: Same as \code{nmfModel('matrix', 'matrix')} but for \code{data.frame} objects, which are generally produced by \code{\link{read.delim}}-like functions. The input \code{data.frame} objects are converted into matrices with \code{\link{as.matrix}}. } \item{nmfModel}{\code{signature(rank = "matrix", target = "ANY")}: Creates an NMF model with arguments \code{rank} and \code{target} swapped. This call is equivalent to \code{nmfModel(rank=target, target=rank, ...)}. This allows to call the \code{nmfModel} function with arguments \code{rank} and \code{target} swapped. It exists for convenience: \itemize{ \item allows typing \code{nmfModel(V)} instead of \code{nmfModel(target=V)} to create a model compatible with a given matrix \code{V} (i.e. of dimension \code{nrow(V), 0, ncol(V)}) \item one can pass the arguments in any order (the one that comes to the user's mind first) and it still works as expected. } } \item{nmfModel}{\code{signature(rank = "formula", target = "ANY")}: Build a formula-based NMF model, that can incorporate fixed basis or coefficient terms. } } } \section{Main factory method}{ The main factory engine of NMF models is implemented by the method with signature \code{numeric, numeric}. Other factory methods provide convenient ways of creating NMF models from e.g. a given target matrix or known basis/coef matrices (see section \emph{Other Factory Methods}). This method creates an object of class \code{model}, using the extra arguments in \code{...} to initialise slots that are specific to the given model. All NMF models implement get/set methods to access the matrix factors (see \code{\link{basis}}), which are called to initialise them from arguments \code{W} and \code{H}. These argument names derive from the definition of all built-in models that inherit derive from class \code{\linkS4class{NMFstd}}, which has two slots, \var{W} and \var{H}, to hold the two factors -- following the notations used in \cite{Lee et al. (1999)}. If argument \code{target} is missing, the method creates a standard NMF model of dimension 0x\code{rank}x0. That is that the basis and mixture coefficient matrices, \var{W} and \var{H}, have dimension 0x\code{rank} and \code{rank}x0 respectively. If target dimensions are also provided in argument \code{target} as a 2-length vector, then the method creates an \code{NMF} object compatible to fit a target matrix of dimension \code{target[1]}x\code{target[2]}. That is that the basis and mixture coefficient matrices, \var{W} and \var{H}, have dimension \code{target[1]}x\code{rank} and \code{rank}x\code{target[2]} respectively. The target dimensions can also be specified using both arguments \code{target} and \code{ncol} to define the number of rows and the number of columns of the target matrix respectively. If no other argument is provided, these matrices are filled with NAs. If arguments \code{W} and/or \code{H} are provided, the method creates a NMF model where the basis and mixture coefficient matrices, \var{W} and \var{H}, are initialised using the values of \code{W} and/or \code{H}. The dimensions given by \code{target}, \code{W} and \code{H}, must be compatible. However if \code{force.dim=TRUE}, the method will reduce the dimensions to the achieve dimension compatibility whenever possible. When \code{W} and \code{H} are both provided, the \code{NMF} object created is suitable to seed a NMF algorithm in a call to the \code{\link{nmf}} method. Note that in this case the factorisation rank is implicitly set by the number of basis components in the seed. } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } #---------- # nmfModel,numeric,numeric-method #---------- # data n <- 20; r <- 3; p <- 10 V <- rmatrix(n, p) # some target matrix # create a r-ranked NMF model with a given target dimensions n x p as a 2-length vector nmfModel(r, c(n,p)) # directly nmfModel(r, dim(V)) # or from an existing matrix <=> nmfModel(r, V) # or alternatively passing each dimension separately nmfModel(r, n, p) # trying to create a NMF object based on incompatible matrices generates an error w <- rmatrix(n, r) h <- rmatrix(r+1, p) try( new('NMFstd', W=w, H=h) ) try( nmfModel(w, h) ) try( nmfModel(r+1, W=w, H=h) ) # The factory method can be force the model to match some target dimensions # but warnings are thrown nmfModel(r, W=w, H=h) nmfModel(r, n-1, W=w, H=h) #---------- # nmfModel,numeric,missing-method #---------- ## Empty model of given rank nmfModel(3) #---------- # nmfModel,missing,ANY-method #---------- nmfModel(target=10) #square nmfModel(target=c(10, 5)) #---------- # nmfModel,missing,missing-method #---------- # Build an empty NMF model nmfModel() # create a NMF object based on one random matrix: the missing matrix is deduced # Note this only works when using factory method NMF n <- 50; r <- 3; w <- rmatrix(n, r) nmfModel(W=w) # create a NMF object based on random (compatible) matrices p <- 20 h <- rmatrix(r, p) nmfModel(H=h) # specifies two compatible matrices nmfModel(W=w, H=h) # error if not compatible try( nmfModel(W=w, H=h[-1,]) ) #---------- # nmfModel,numeric,matrix-method #---------- # create a r-ranked NMF model compatible with a given target matrix obj <- nmfModel(r, V) all(is.na(basis(obj))) #---------- # nmfModel,matrix,matrix-method #---------- ## From two existing factors # allows a convenient call without argument names w <- rmatrix(n, 3); h <- rmatrix(3, p) nmfModel(w, h) # Specify the type of NMF model (e.g. 'NMFns' for non-smooth NMF) mod <- nmfModel(w, h, model='NMFns') mod # One can use such an NMF model as a seed when fitting a target matrix with nmf() V <- rmatrix(mod) res <- nmf(V, mod) nmf.equal(res, nmf(V, mod)) # NB: when called only with such a seed, the rank and the NMF algorithm # are selected based on the input NMF model. # e.g. here rank was 3 and the algorithm "nsNMF" is used, because it is the default # algorithm to fit "NMFns" models (See ?nmf). #---------- # nmfModel,matrix,ANY-method #---------- ## swapped arguments `rank` and `target` V <- rmatrix(20, 10) nmfModel(V) # equivalent to nmfModel(target=V) nmfModel(V, 3) # equivalent to nmfModel(3, V) #---------- # nmfModel,formula,ANY-method #---------- # empty 3-rank model nmfModel(~ 3) # 3-rank model that fits a given data matrix x <- rmatrix(20,10) nmfModel(x ~ 3) # add fixed coefficient term defined by a factor gr <- gl(2, 5) nmfModel(x ~ 3 + gr) # add fixed coefficient term defined by a numeric covariate nmfModel(x ~ 3 + gr + b, data=list(b=runif(10))) # 3-rank model that fits a given ExpressionSet (with fixed coef terms) e <- ExpressionSet(x) pData(e) <- data.frame(a=runif(10)) nmfModel(e ~ 3 + gr + a) # `a` is looked up in the phenotypic data of x pData(x) #---------- # nmfModels #---------- # show all the NMF models available (i.e. the classes that inherit from class NMF) nmfModels() # show all the built-in NMF models available nmfModels(builtin.only=TRUE) } \references{ Lee DD and Seung HS (1999). "Learning the parts of objects by non-negative matrix factorization." _Nature_, *401*(6755), pp. 788-91. ISSN 0028-0836, , . } \seealso{ \code{\link{is.empty.nmf}} Other NMF-interface: \code{\link{basis}}, \code{\link{.basis}}, \code{\link{.basis<-}}, \code{\link{basis<-}}, \code{\link{coef}}, \code{\link{.coef}}, \code{\link{.coef<-}}, \code{\link{coef<-}}, \code{\link{coefficients}}, \code{\link{.DollarNames,NMF-method}}, \code{\link{loadings,NMF-method}}, \code{\link{misc}}, \code{\link{NMF-class}}, \code{\link{$<-,NMF-method}}, \code{\link{$,NMF-method}}, \code{\link{rnmf}}, \code{\link{scoef}} } \keyword{methods} NMF/man/scores.Rd0000644000176000001440000001752012305630424013266 0ustar ripleyusers\docType{methods} \name{featureScore} \alias{extractFeatures} \alias{extractFeatures,matrix-method} \alias{extractFeatures-methods} \alias{extractFeatures,NMF-method} \alias{featureScore} \alias{featureScore,matrix-method} \alias{featureScore-methods} \alias{featureScore,NMF-method} \title{Feature Selection in NMF Models} \usage{ featureScore(object, ...) \S4method{featureScore}{matrix}(object, method = c("kim", "max")) extractFeatures(object, ...) \S4method{extractFeatures}{matrix}(object, method = c("kim", "max"), format = c("list", "combine", "subset"), nodups = TRUE) } \arguments{ \item{object}{an object from which scores/features are computed/extracted} \item{...}{extra arguments to allow extension} \item{method}{scoring or selection method. It specifies the name of one of the method described in sections \emph{Feature scores} and \emph{Feature selection}. Additionally for \code{extractFeatures}, it may be an integer vector that indicates the number of top most contributing features to extract from each column of \code{object}, when ordered in decreasing order, or a numeric value between 0 and 1 that indicates the minimum relative basis contribution above which a feature is selected (i.e. basis contribution threshold). In the case of a single numeric value (integer or percentage), it is used for all columns. Note that \code{extractFeatures(x, 1)} means relative contribution threshold of 100\%, to select the top contributing features one must explicitly specify an integer value as in \code{extractFeatures(x, 1L)}. However, if all elements in methods are > 1, they are automatically treated as if they were integers: \code{extractFeatures(x, 2)} means the top-2 most contributing features in each component.} \item{format}{output format. The following values are accepted: \describe{ \item{\sQuote{list}}{(default) returns a list with one element per column in \code{object}, each containing the indexes of the selected features, as an integer vector. If \code{object} has row names, these are used to name each index vector. Components for which no feature were selected are assigned a \code{NA} value.} \item{\sQuote{combine}}{ returns all indexes in a single vector. Duplicated indexes are made unique if \code{nodups=TRUE} (default).} \item{\sQuote{subset}}{ returns an object of the same class as \code{object}, but subset with the selected indexes, so that it contains data only from basis-specific features.} }} \item{nodups}{logical that indicates if duplicated indexes, i.e. features selected on multiple basis components (which should in theory not happen), should be only appear once in the result. Only used when \code{format='combine'}.} } \value{ \code{featureScore} returns a numeric vector of the length the number of rows in \code{object} (i.e. one score per feature). \code{extractFeatures} returns the selected features as a list of indexes, a single integer vector or an object of the same class as \code{object} that only contains the selected features. } \description{ The function \code{featureScore} implements different methods to computes basis-specificity scores for each feature in the data. The function \code{extractFeatures} implements different methods to select the most basis-specific features of each basis component. } \details{ One of the properties of Nonnegative Matrix Factorization is that is tend to produce sparse representation of the observed data, leading to a natural application to bi-clustering, that characterises groups of samples by a small number of features. In NMF models, samples are grouped according to the basis components that contributes the most to each sample, i.e. the basis components that have the greatest coefficient in each column of the coefficient matrix (see \code{\link{predict,NMF-method}}). Each group of samples is then characterised by a set of features selected based on basis-specifity scores that are computed on the basis matrix. } \section{Methods}{ \describe{ \item{extractFeatures}{\code{signature(object = "matrix")}: Select features on a given matrix, that contains the basis component in columns. } \item{extractFeatures}{\code{signature(object = "NMF")}: Select basis-specific features from an NMF model, by applying the method \code{extractFeatures,matrix} to its basis matrix. } \item{featureScore}{\code{signature(object = "matrix")}: Computes feature scores on a given matrix, that contains the basis component in columns. } \item{featureScore}{\code{signature(object = "NMF")}: Computes feature scores on the basis matrix of an NMF model. } } } \section{Feature scores}{ The function \code{featureScore} can compute basis-specificity scores using the following methods: \describe{ \item{\sQuote{kim}}{ Method defined by \cite{Kim et al. (2007)}. The score for feature \eqn{i} is defined as: \deqn{S_i = 1 + \frac{1}{\log_2 k} \sum_{q=1}^k p(i,q) \log_2 p(i,q)}{ S_i = 1 + 1/log2(k) sum_q [ p(i,q) log2( p(i,q) ) ] }, where \eqn{p(i,q)} is the probability that the \eqn{i}-th feature contributes to basis \eqn{q}: \deqn{p(i,q) = \frac{W(i,q)}{\sum_{r=1}^k W(i,r)} }{ p(i,q) = W(i,q) / (sum_r W(i,r)) } The feature scores are real values within the range [0,1]. The higher the feature score the more basis-specific the corresponding feature. } \item{\sQuote{max}}{Method defined by \cite{Carmona-Saez et al. (2006)}. The feature scores are defined as the row maximums. } } } \section{Feature selection}{ The function \code{extractFeatures} can select features using the following methods: \describe{ \item{\sQuote{kim}}{ uses \cite{Kim et al. (2007)} scoring schema and feature selection method. The features are first scored using the function \code{featureScore} with method \sQuote{kim}. Then only the features that fulfil both following criteria are retained: \itemize{ \item score greater than \eqn{\hat{\mu} + 3 \hat{\sigma}}, where \eqn{\hat{\mu}} and \eqn{\hat{\sigma}} are the median and the median absolute deviation (MAD) of the scores respectively; \item the maximum contribution to a basis component is greater than the median of all contributions (i.e. of all elements of W). } } \item{\sQuote{max}}{ uses the selection method used in the \code{bioNMF} software package and described in \cite{Carmona-Saez et al. (2006)}. For each basis component, the features are first sorted by decreasing contribution. Then, one selects only the first consecutive features whose highest contribution in the basis matrix is effectively on the considered basis. } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # random NMF model x <- rnmf(3, 50,20) # probably no feature is selected extractFeatures(x) # extract top 5 for each basis extractFeatures(x, 5L) # extract features that have a relative basis contribution above a threshold extractFeatures(x, 0.5) # ambiguity? extractFeatures(x, 1) # means relative contribution above 100\% extractFeatures(x, 1L) # means top contributing feature in each component } \references{ Kim H and Park H (2007). "Sparse non-negative matrix factorizations via alternating non-negativity-constrained least squares for microarray data analysis." _Bioinformatics (Oxford, England)_, *23*(12), pp. 1495-502. ISSN 1460-2059, , . Carmona-Saez P, Pascual-Marqui RD, Tirado F, Carazo JM and Pascual-Montano A (2006). "Biclustering of gene expression data by Non-smooth Non-negative Matrix Factorization." _BMC bioinformatics_, *7*, pp. 78. ISSN 1471-2105, , . } \keyword{methods} NMF/man/nsNMF-nmf.Rd0000644000176000001440000001062512305630424013526 0ustar ripleyusers\name{nmf_update.ns} \alias{nmfAlgorithm.nsNMF} \alias{nmfAlgorithm.nsNMF_R} \alias{nmf_update.ns} \alias{nmf_update.ns_R} \alias{nsNMF_R-nmf} \title{NMF Multiplicative Update for Nonsmooth Nonnegative Matrix Factorization (nsNMF).} \usage{ nmf_update.ns(i, v, x, copy = FALSE, ...) nmf_update.ns_R(i, v, x, ...) nmfAlgorithm.nsNMF_R(..., .stop = NULL, maxIter = nmf.getOption("maxIter") \%||\% 2000, stopconv = 40, check.interval = 10) nmfAlgorithm.nsNMF(..., .stop = NULL, maxIter = nmf.getOption("maxIter") \%||\% 2000, copy = FALSE, stopconv = 40, check.interval = 10) } \arguments{ \item{i}{current iteration number.} \item{v}{target matrix.} \item{x}{current NMF model, as an \code{\linkS4class{NMF}} object.} \item{copy}{logical that indicates if the update should be made on the original matrix directly (\code{FALSE}) or on a copy (\code{TRUE} - default). With \code{copy=FALSE} the memory footprint is very small, and some speed-up may be achieved in the case of big matrices. However, greater care should be taken due the side effect. We recommend that only experienced users use \code{copy=TRUE}.} \item{...}{extra arguments. These are generally not used and present only to allow other arguments from the main call to be passed to the initialisation and stopping criterion functions (slots \code{onInit} and \code{Stop} respectively).} \item{.stop}{specification of a stopping criterion, that is used instead of the one associated to the NMF algorithm. It may be specified as: \itemize{ \item the access key of a registered stopping criterion; \item a single integer that specifies the exact number of iterations to perform, which will be honoured unless a lower value is explicitly passed in argument \code{maxIter}. \item a single numeric value that specifies the stationnarity threshold for the objective function, used in with \code{\link{nmf.stop.stationary}}; \item a function with signature \code{(object="NMFStrategy", i="integer", y="matrix", x="NMF", ...)}, where \code{object} is the \code{NMFStrategy} object that describes the algorithm being run, \code{i} is the current iteration, \code{y} is the target matrix and \code{x} is the current value of the NMF model. }} \item{maxIter}{maximum number of iterations to perform.} \item{stopconv}{number of iterations intervals over which the connectivity matrix must not change for stationarity to be achieved.} \item{check.interval}{interval (in number of iterations) on which the stopping criterion is computed.} } \value{ an \code{\linkS4class{NMFns}} model object. } \description{ These update rules, defined for the \code{\linkS4class{NMFns}} model \eqn{V \approx W S H} from \cite{Pascual-Montano et al. (2006)}, that introduces an intermediate smoothing matrix to enhance sparsity of the factors. \code{nmf_update.ns} computes the updated nsNMF model. It uses the optimized \emph{C++} implementations \code{\link{nmf_update.KL.w}} and \code{\link{nmf_update.KL.h}} to update \eqn{W} and \eqn{H} respectively. \code{nmf_update.ns_R} implements the same updates in \emph{plain R}. Algorithms \sQuote{nsNMF} and \sQuote{.R#nsNMF} provide the complete NMF algorithm from \cite{Pascual-Montano et al. (2006)}, using the C++-optimised and plain R updates \code{\link{nmf_update.brunet}} and \code{\link{nmf_update.brunet_R}} respectively. The stopping criterion is based on the stationarity of the connectivity matrix. } \details{ The multiplicative updates are based on the updates proposed by \cite{Brunet et al. (2004)}, except that the NMF estimate \eqn{W H} is replaced by \eqn{W S H} and \eqn{W} (resp. \eqn{H}) is replaced by \eqn{W S} (resp. \eqn{S H}) in the update of \eqn{H} (resp. \eqn{W}). See \code{\link{nmf_update.KL}} for more details on the update formula. } \references{ Pascual-Montano A, Carazo JM, Kochi K, Lehmann D and Pascual-marqui RD (2006). "Nonsmooth nonnegative matrix factorization (nsNMF)." _IEEE Trans. Pattern Anal. Mach. Intell_, *28*, pp. 403-415. Brunet J, Tamayo P, Golub TR and Mesirov JP (2004). "Metagenes and molecular pattern discovery using matrix factorization." _Proceedings of the National Academy of Sciences of the United States of America_, *101*(12), pp. 4164-9. ISSN 0027-8424, , . } NMF/man/show-commaNMFfitX-method.Rd0000644000176000001440000000045712234465004016516 0ustar ripleyusers\docType{methods} \name{show,NMFfitX-method} \alias{show,NMFfitX-method} \title{Show method for objects of class \code{NMFfitX}} \usage{ \S4method{show}{NMFfitX}(object) } \arguments{ \item{object}{Any R object} } \description{ Show method for objects of class \code{NMFfitX} } \keyword{methods} NMF/man/show-commaNMFfitXn-method.Rd0000644000176000001440000000046412234465004016672 0ustar ripleyusers\docType{methods} \name{show,NMFfitXn-method} \alias{show,NMFfitXn-method} \title{Show method for objects of class \code{NMFfitXn}} \usage{ \S4method{show}{NMFfitXn}(object) } \arguments{ \item{object}{Any R object} } \description{ Show method for objects of class \code{NMFfitXn} } \keyword{methods} NMF/man/parse_formula.Rd0000644000176000001440000000075612234465004014633 0ustar ripleyusers\name{parse_formula} \alias{parse_formula} \title{Simple Parsing of Formula} \usage{ parse_formula(x) } \arguments{ \item{x}{formula to parse} } \value{ a list with the following elements: \item{response}{ logical that indicates if the formula has a response term.} \item{y}{ name of the response variable.} \item{x}{ list of regressor variable names.} \item{n}{ number of regressor variables.} } \description{ Formula parser for formula-based NMF models. } \keyword{internal} NMF/man/algorithm-commaNMFList-method.Rd0000644000176000001440000000154012234465004017517 0ustar ripleyusers\docType{methods} \name{algorithm,NMFList-method} \alias{algorithm,NMFList-method} \title{Returns the method names used to compute the NMF fits in the list. It returns \code{NULL} if the list is empty.} \usage{ \S4method{algorithm}{NMFList}(object, string = FALSE, unique = TRUE) } \arguments{ \item{string}{a logical that indicate whether the names should be collapsed into a comma-separated string.} \item{unique}{a logical that indicates whether the result should contain the set of method names, removing duplicated names. This argument is forced to \code{TRUE} when \code{string=TRUE}.} \item{object}{an object computed using some algorithm, or that describes an algorithm itself.} } \description{ Returns the method names used to compute the NMF fits in the list. It returns \code{NULL} if the list is empty. } \keyword{methods} NMF/man/nmfApply.Rd0000644000176000001440000000467412234465004013565 0ustar ripleyusers\name{nmfApply} \alias{nmfApply} \title{Apply Function for NMF Objects} \usage{ nmfApply(X, MARGIN, FUN, ..., simplify = TRUE, USE.NAMES = TRUE) } \arguments{ \item{X}{an object that has suitable \code{\link{basis}} and \code{coef} methods, e.g. an NMF model.} \item{MARGIN}{a single numeric (integer) value that specifies over which margin(s) the function \code{FUN} is applied. See section \emph{Details} for a list of possible values.} \item{FUN}{a function to apply over the specified margins.} \item{...}{extra arguments passed to \code{FUN}} \item{simplify}{a logical only used when \code{MARGIN=3}, that indicates if \code{sapply} should try to simplify result if possible. Since this argument follows \sQuote{...} its name cannot be abbreviated.} \item{USE.NAMES}{a logical only used when \code{MARGIN=3}, that indicates if \code{sapply} should use the names of the basis components to name the results if present. Since this argument follows \sQuote{...} its name cannot be abbreviated.} } \value{ a vector or a list. See \code{\link[base]{apply}} and \code{\link[base]{sapply}} for more details on the output format. } \description{ The function \code{nmfApply} provides exteneded \code{apply}-like functionality for objects of class \code{NMF}. It enables to easily apply a function over different margins of NMF models. } \details{ The function \code{FUN} is applied via a call to \code{\link{apply}} or \code{\link{sapply}} according to the value of argument \code{MARGIN} as follows: \describe{ \item{MARGIN=1}{ apply \code{FUN} to each \emph{row} of the basis matrix: \code{apply(basis(X), 1L, FUN, ...)}.} \item{MARGIN=2}{ apply \code{FUN} to each \emph{column} of the coefficient matrix: \code{apply(coef(X), 2L, FUN, ...)}.} \item{MARGIN=3}{ apply \code{FUN} to each \emph{pair} of associated basis component and basis profile: more or less \code{sapply(seq(nbasis(X)), function(i, ...) FUN(basis(X)[,i], coef(X)[i, ], ...), ...)}. In this case \code{FUN} must be have at least two arguments, to which are passed each basis components and basis profiles respectively -- as numeric vectors.} \item{MARGIN=4}{ apply \code{FUN} to each \emph{column} of the basis matrix, i.e. to each basis component: \code{apply(basis(X), 2L, FUN, ...)}.} \item{MARGIN=5}{ apply \code{FUN} to each \emph{row} of the coefficient matrix: \code{apply(coef(X), 1L, FUN, ...)}.} } } NMF/man/ccBreaks.Rd0000644000176000001440000000036012234465004013500 0ustar ripleyusers\name{ccBreaks} \alias{ccBreaks} \title{Generate Break Intervals from Numeric Variables} \usage{ ccBreaks(x, breaks) } \description{ Implementation is borrowed from the R core function \code{\link{cut.default}}. } \keyword{internal} NMF/man/show-commaNMFfit-method.Rd0000644000176000001440000000045212234465004016361 0ustar ripleyusers\docType{methods} \name{show,NMFfit-method} \alias{show,NMFfit-method} \title{Show method for objects of class \code{NMFfit}} \usage{ \S4method{show}{NMFfit}(object) } \arguments{ \item{object}{Any R object} } \description{ Show method for objects of class \code{NMFfit} } \keyword{methods} NMF/man/nmfObject.Rd0000644000176000001440000000136712234465004013702 0ustar ripleyusers\name{nmfObject} \alias{nmfObject} \title{Updating NMF Objects} \usage{ nmfObject(object, verbose = FALSE) } \arguments{ \item{object}{an R object created by the NMF package, e.g., an object of class \code{\linkS4class{NMF}} or \code{\linkS4class{NMFfit}}.} \item{verbose}{logical to toggle verbose messages.} } \description{ This function serves to update an objects created with previous versions of the NMF package, which would otherwise be incompatible with the current version, due to changes in their S4 class definition. } \details{ This function makes use of heuristics to automatically update object slots, which have been borrowed from the BiocGenerics package, the function \code{updateObjectFromSlots} in particular. } NMF/man/profplot.Rd0000644000176000001440000001010112305630424013621 0ustar ripleyusers\name{profplot} \alias{profplot} \alias{profplot.default} \title{Plotting Expression Profiles} \usage{ profplot(x, ...) \method{profplot}{default} (x, y, scale = c("none", "max", "c1"), match.names = TRUE, legend = TRUE, confint = TRUE, Colv, labels, annotation, ..., add = FALSE) } \arguments{ \item{x}{a matrix or an NMF object from which is extracted the mixture coefficient matrix. It is extracted from the best fit if \code{x} is the results from multiple NMF runs.} \item{y}{a matrix or an NMF object from which is extracted the mixture coefficient matrix. It is extracted from the best fit if \code{y} is the results from multiple NMF runs.} \item{scale}{specifies how the data should be scaled before plotting. If \code{'none'} or \code{NA}, then no scaling is applied and the "raw" data is plotted. If \code{TRUE} or \code{'max'} then each row of both matrices are normalised with their respective maximum values. If \code{'c1'}, then each column of both matrix is scaled into proportions (i.e. to sum up to one). Default is \code{'none'}.} \item{match.names}{a logical that indicates if the profiles in \code{y} should be subset and/or re-ordered to match the profile names in \code{x} (i.e. the rownames). This is attempted only when both \code{x} and \code{y} have names.} \item{legend}{a logical that specifies whether drawing the legend or not, or coordinates specifications passed to argument \code{x} of \code{\link{legend}}, that specifies the position of the legend.} \item{confint}{logical that indicates if confidence intervals for the R-squared should be shown in legend.} \item{Colv}{specifies the way the columns of \code{x} are ordered before plotting. It is used only when \code{y} is missing. It can be: \itemize{ \item a single numeric value, specifying the index of a row of \code{x}, that is used to order the columns by \code{x[, order(x[abs(Colv),])]}. Decreasing order is specified with a negative index. \item an integer vector directly specifying the order itself, in which case the columns are ordered by \code{x[, Colv]} \item a factor used to order the columns by \code{x[, order(Colv)]} and as argument \code{annotation} if this latter is missing or not \code{NA}. \item any other object with a suitable \code{order} method. The columns are by \code{x[, order(Colv)]} }} \item{labels}{a character vector containing labels for each sample (i.e. each column of \code{x}). These are used for labelling the x-axis.} \item{annotation}{a factor annotating each sample (i.e. each column of \code{x}). If not missing, a coloured raw is plotted under the x-axis and annotates each sample accordingly. If argument \code{Colv} is a factor, then it is used to annotate the plot, unless \code{annotation=NA}.} \item{...}{graphical parameters passed to \code{\link{matplot}} or \code{\link{matpoints}}.} \item{add}{logical that indicates if the plot should be added as points to a previous plot} } \description{ Plotting Expression Profiles When using NMF for clustering in particular, one looks for strong associations between the basis and a priori known groups of samples. Plotting the profiles may highlight such patterns. } \details{ The function can also be used to compare the profiles from two NMF models or mixture coefficient matrices. In this case, it draws a scatter plot of the paired profiles. } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # create a random target matrix v <- rmatrix(50, 10) # fit a single NMF model res <- nmf(v, 3) profplot(res) # ordering according to first profile profplot(res, Colv=1) # increasing profplot(res, Colv=-1) # decreasing # fit a multi-run NMF model res2 <- nmf(v, 3, nrun=3) profplot(res2) # draw a profile correlation plot: this show how the basis components are # returned in an unpredictable order profplot(res, res2) # looking at all the correlations allow to order the components in a "common" order profcor(res, res2) } \seealso{ \code{\link{profcor}} } \keyword{aplot} NMF/man/NMFSeed-class.Rd0000644000176000001440000000247412234465004014317 0ustar ripleyusers\docType{class} \name{NMFSeed-class} \alias{NMFSeed-class} \title{Base class that defines the interface for NMF seeding methods.} \description{ This class implements a simple wrapper strategy object that defines a unified interface to seeding methods, that are used to initialise NMF models before fitting them with any NMF algorithm. } \section{Slots}{ \describe{ \item{name}{character string giving the name of the seeding strategy} \item{method}{workhorse function that implements the seeding strategy. It must have signature \code{(object="NMF", x="matrix", ...)} and initialise the NMF model \code{object} with suitable values for fitting the target matrix \code{x}.} } } \section{Methods}{ \describe{ \item{algorithm}{\code{signature(object = "NMFSeed")}: Returns the workhorse function of the seeding method described by \code{object}. } \item{algorithm<-}{\code{signature(object = "NMFSeed", value = "function")}: Sets the workhorse function of the seeding method described by \code{object}. } \item{NMFSeed}{\code{signature(key = "NMFSeed")}: Creates an \code{NMFSeed} based on a template object (Constructor-Copy), in particular it uses the \strong{same} name. } \item{show}{\code{signature(object = "NMFSeed")}: Show method for objects of class \code{NMFSeed} } } } NMF/man/runtime.all-commaNMFfitXn-method.Rd0000644000176000001440000000164412234465004020145 0ustar ripleyusers\docType{methods} \name{runtime.all,NMFfitXn-method} \alias{runtime.all,NMFfitXn-method} \title{Returns the CPU time used to perform all the NMF fits stored in \code{object}.} \usage{ \S4method{runtime.all}{NMFfitXn}(object, null = FALSE, warning = TRUE) } \arguments{ \item{null}{a logical that indicates if the sequential time should be returned if no time data is available in slot \sQuote{runtime.all}.} \item{warning}{a logical that indicates if a warning should be thrown if the sequential time is returned instead of the real CPU time.} \item{object}{an object computed using some algorithm, or that describes an algorithm itself.} } \description{ If no time data is available from in slot \sQuote{runtime.all} and argument \code{null=TRUE}, then the sequential time as computed by \code{\link{seqtime}} is returned, and a warning is thrown unless \code{warning=FALSE}. } \keyword{methods} NMF/man/nmfEstimateRank.Rd0000644000176000001440000001647212305630424015065 0ustar ripleyusers\name{nmfEstimateRank} \alias{nmfEstimateRank} \alias{plot.NMF.rank} \title{Estimate Rank for NMF Models} \usage{ nmfEstimateRank(x, range, method = nmf.getOption("default.algorithm"), nrun = 30, model = NULL, ..., verbose = FALSE, stop = FALSE) \method{plot}{NMF.rank} (x, y = NULL, what = c("all", "cophenetic", "rss", "residuals", "dispersion", "evar", "sparseness", "sparseness.basis", "sparseness.coef", "silhouette", "silhouette.coef", "silhouette.basis", "silhouette.consensus"), na.rm = FALSE, xname = "x", yname = "y", xlab = "Factorization rank", ylab = "", main = "NMF rank survey", ...) } \arguments{ \item{x}{For \code{nmfEstimateRank} a target object to be estimated, in one of the format accepted by interface \code{\link{nmf}}. For \code{plot.NMF.rank} an object of class \code{NMF.rank} as returned by function \code{nmfEstimateRank}.} \item{range}{a \code{numeric} vector containing the ranks of factorization to try. Note that duplicates are removed and values are sorted in increasing order. The results are notably returned in this order.} \item{method}{A single NMF algorithm, in one of the format accepted by the function \code{\link{nmf}}.} \item{nrun}{a \code{numeric} giving the number of run to perform for each value in \code{range}.} \item{model}{model specification passed to each \code{nmf} call. In particular, when \code{x} is a formula, it is passed to argument \code{data} of \code{\link{nmfModel}} to determine the target matrix -- and fixed terms.} \item{verbose}{toggle verbosity. This parameter only affects the verbosity of the outer loop over the values in \code{range}. To print verbose (resp. debug) messages from each NMF run, one can use \code{.options='v'} (resp. \code{.options='d'}) that will be passed to the function \code{\link{nmf}}.} \item{stop}{logical flag for running the estimation process with fault tolerance. When \code{TRUE}, the whole execution will stop if any error is raised. When \code{FALSE} (default), the runs that raise an error will be skipped, and the execution will carry on. The summary measures for the runs with errors are set to NA values, and a warning is thrown.} \item{...}{For \code{nmfEstimateRank}, these are extra parameters passed to interface \code{nmf}. Note that the same parameters are used for each value of the rank. See \code{\link{nmf}}. For \code{plot.NMF.rank}, these are extra graphical parameter passed to the standard function \code{plot}. See \code{\link{plot}}.} \item{y}{reference object of class \code{NMF.rank}, as returned by function \code{nmfEstimateRank}. The measures contained in \code{y} are used and plotted as a reference. It is typically used to plot results obtained from randomized data. The associated curves are drawn in \emph{red} (and \emph{pink}), while those from \code{x} are drawn in \emph{blue} (and \emph{green}).} \item{what}{a \code{character} vector whose elements partially match one of the following item, which correspond to the measures computed by \code{\link{summary}} on each -- multi-run -- NMF result: \sQuote{all}, \sQuote{cophenetic}, \sQuote{rss}, \sQuote{residuals}, \sQuote{dispersion}, \sQuote{evar}, \sQuote{silhouette} (and more specific *.coef, *.basis, *.consensus), \sQuote{sparseness} (and more specific *.coef, *.basis). It specifies which measure must be plotted (\code{what='all'} plots all the measures).} \item{na.rm}{single logical that specifies if the rank for which the measures are NA values should be removed from the graph or not (default to \code{FALSE}). This is useful when plotting results which include NAs due to error during the estimation process. See argument \code{stop} for \code{nmfEstimateRank}.} \item{xname,yname}{legend labels for the curves corresponding to measures from \code{x} and \code{y} respectively} \item{xlab}{x-axis label} \item{ylab}{y-axis label} \item{main}{main title} } \value{ \code{nmfEstimateRank} returns a S3 object (i.e. a list) of class \code{NMF.rank} with the following elements: \item{measures }{a \code{data.frame} containing the quality measures for each rank of factorizations in \code{range}. Each row corresponds to a measure, each column to a rank. } \item{consensus }{ a \code{list} of consensus matrices, indexed by the rank of factorization (as a character string).} \item{fit }{ a \code{list} of the fits, indexed by the rank of factorization (as a character string).} } \description{ A critical parameter in NMF algorithms is the factorization rank \eqn{r}. It defines the number of basis effects used to approximate the target matrix. Function \code{nmfEstimateRank} helps in choosing an optimal rank by implementing simple approaches proposed in the literature. Note that from version \emph{0.7}, one can equivalently call the function \code{\link{nmf}} with a range of ranks. In the plot generated by \code{plot.NMF.rank}, each curve represents a summary measure over the range of ranks in the survey. The colours correspond to the type of data to which the measure is related: coefficient matrix, basis component matrix, best fit, or consensus matrix. } \details{ Given a NMF algorithm and the target matrix, a common way of estimating \eqn{r} is to try different values, compute some quality measures of the results, and choose the best value according to this quality criteria. See \cite{Brunet et al. (2004)} and \cite{Hutchins et al. (2008)}. The function \code{nmfEstimateRank} allows to perform this estimation procedure. It performs multiple NMF runs for a range of rank of factorization and, for each, returns a set of quality measures together with the associated consensus matrix. In order to avoid overfitting, it is recommended to run the same procedure on randomized data. The results on the original and the randomised data may be plotted on the same plots, using argument \code{y}. } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } if( !isCHECK() ){ set.seed(123456) n <- 50; r <- 3; m <- 20 V <- syntheticNMF(n, r, m) # Use a seed that will be set before each first run res <- nmfEstimateRank(V, seq(2,5), method='brunet', nrun=10, seed=123456) # or equivalently res <- nmf(V, seq(2,5), method='brunet', nrun=10, seed=123456) # plot all the measures plot(res) # or only one: e.g. the cophenetic correlation coefficient plot(res, 'cophenetic') # run same estimation on randomized data rV <- randomize(V) rand <- nmfEstimateRank(rV, seq(2,5), method='brunet', nrun=10, seed=123456) plot(res, rand) } } \references{ Brunet J, Tamayo P, Golub TR and Mesirov JP (2004). "Metagenes and molecular pattern discovery using matrix factorization." _Proceedings of the National Academy of Sciences of the United States of America_, *101*(12), pp. 4164-9. ISSN 0027-8424, , . Hutchins LN, Murphy SM, Singh P and Graber JH (2008). "Position-dependent motif characterization using non-negative matrix factorization." _Bioinformatics (Oxford, England)_, *24*(23), pp. 2684-90. ISSN 1367-4811, , . } NMF/man/basiscor.Rd0000644000176000001440000000642212305630424013574 0ustar ripleyusers\docType{methods} \name{basiscor} \alias{basiscor} \alias{basiscor,matrix,NMF-method} \alias{basiscor-methods} \alias{basiscor,NMF,matrix-method} \alias{basiscor,NMF,missing-method} \alias{basiscor,NMF,NMF-method} \alias{profcor} \alias{profcor,matrix,NMF-method} \alias{profcor-methods} \alias{profcor,NMF,matrix-method} \alias{profcor,NMF,missing-method} \alias{profcor,NMF,NMF-method} \title{Correlations in NMF Models} \usage{ basiscor(x, y, ...) profcor(x, y, ...) } \arguments{ \item{x}{a matrix or an object with suitable methods \code{\link{basis}} or \code{\link{coef}}.} \item{y}{a matrix or an object with suitable methods \code{\link{basis}} or \code{\link{coef}}, and dimensions compatible with \code{x}. If missing the correlations are computed between \code{x} and \code{y=x}.} \item{...}{extra arguments passed to \code{\link{cor}}.} } \description{ \code{basiscor} computes the correlation matrix between basis vectors, i.e. the \emph{columns} of its basis matrix -- which is the model's first matrix factor. \code{profcor} computes the correlation matrix between basis profiles, i.e. the \emph{rows} of the coefficient matrix -- which is the model's second matrix factor. } \details{ Each generic has methods defined for computing correlations between NMF models and/or compatible matrices. The computation is performed by the base function \code{\link{cor}}. } \section{Methods}{ \describe{ \item{basiscor}{\code{signature(x = "NMF", y = "matrix")}: Computes the correlations between the basis vectors of \code{x} and the columns of \code{y}. } \item{basiscor}{\code{signature(x = "matrix", y = "NMF")}: Computes the correlations between the columns of \code{x} and the the basis vectors of \code{y}. } \item{basiscor}{\code{signature(x = "NMF", y = "NMF")}: Computes the correlations between the basis vectors of \code{x} and \code{y}. } \item{basiscor}{\code{signature(x = "NMF", y = "missing")}: Computes the correlations between the basis vectors of \code{x}. } \item{profcor}{\code{signature(x = "NMF", y = "matrix")}: Computes the correlations between the basis profiles of \code{x} and the rows of \code{y}. } \item{profcor}{\code{signature(x = "matrix", y = "NMF")}: Computes the correlations between the rows of \code{x} and the basis profiles of \code{y}. } \item{profcor}{\code{signature(x = "NMF", y = "NMF")}: Computes the correlations between the basis profiles of \code{x} and \code{y}. } \item{profcor}{\code{signature(x = "NMF", y = "missing")}: Computes the correlations between the basis profiles of \code{x}. } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # generate two random NMF models a <- rnmf(3, 100, 20) b <- rnmf(3, 100, 20) # Compute auto-correlations basiscor(a) profcor(a) # Compute correlations with b basiscor(a, b) profcor(a, b) # try to recover the underlying NMF model 'a' from noisy data res <- nmf(fitted(a) + rmatrix(a), 3) # Compute correlations with the true model basiscor(a, res) profcor(a, res) # Compute correlations with a random compatible matrix W <- rmatrix(basis(a)) basiscor(a, W) identical(basiscor(a, W), basiscor(W, a)) H <- rmatrix(coef(a)) profcor(a, H) identical(profcor(a, H), profcor(H, a)) } \keyword{methods} NMF/man/subset-NMF.Rd0000644000176000001440000001155512305630424013715 0ustar ripleyusers\docType{methods} \name{[,NMF-method} \alias{[,NMF-method} \title{Sub-setting NMF Objects} \usage{ \S4method{[}{NMF}(x, i, j, ..., drop = FALSE) } \arguments{ \item{i}{index used to subset on the \strong{rows} of the basis matrix (i.e. the features). It can be a \code{numeric}, \code{logical}, or \code{character} vector (whose elements must match the row names of \code{x}). In the case of a \code{logical} vector the entries are recycled if necessary.} \item{j}{index used to subset on the \strong{columns} of the mixture coefficient matrix (i.e. the samples). It can be a \code{numeric}, \code{logical}, or \code{character} vector (whose elements must match the column names of \code{x}). In the case of a \code{logical} vector the entries are recycled if necessary.} \item{...}{used to specify a third index to subset on the basis components, i.e. on both the columns and rows of the basis matrix and mixture coefficient respectively. It can be a \code{numeric}, \code{logical}, or \code{character} vector (whose elements must match the basis names of \code{x}). In the case of a \code{logical} vector the entries are recycled if necessary. Note that only the first extra subset index is used. A warning is thrown if more than one extra argument is passed in \code{...}.} \item{drop}{single \code{logical} value used to drop the \code{NMF-class} wrapping and only return subsets of one of the factor matrices (see \emph{Details})} \item{x}{ object from which to extract element(s) or in which to replace element(s). } } \description{ This method provides a convenient way of sub-setting objects of class \code{NMF}, using a matrix-like syntax. It allows to consistently subset one or both matrix factors in the NMF model, as well as retrieving part of the basis components or part of the mixture coefficients with a reduced amount of code. } \details{ The returned value depends on the number of subset index passed and the value of argument \code{drop}: \itemize{ \item No index as in \code{x[]} or \code{x[,]}: the value is the object \code{x} unchanged. \item One single index as in \code{x[i]}: the value is the complete NMF model composed of the selected basis components, subset by \code{i}, except if argument \code{drop=TRUE}, or if it is missing and \code{i} is of length 1. Then only the basis matrix is returned with dropped dimensions: \code{x[i, drop=TRUE]} <=> \code{drop(basis(x)[, i])}. This means for example that \code{x[1L]} is the first basis vector, and \code{x[1:3, drop = TRUE]} is the matrix composed of the 3 first basis vectors -- in columns. Note that in version <= 0.18.3, the call \code{x[i, drop = TRUE.or.FALSE]} was equivalent to \code{basis(x)[, i, drop=TRUE.or.FALSE]}. \item More than one index with \code{drop=FALSE} (default) as in \code{x[i,j]}, \code{x[i,]}, \code{x[,j]}, \code{x[i,j,k]}, \code{x[i,,k]}, etc...: the value is a \code{NMF} object whose basis and/or mixture coefficient matrices have been subset accordingly. The third index \code{k} affects simultaneously the columns of the basis matrix AND the rows of the mixture coefficient matrix. In this case argument \code{drop} is not used. \item More than one index with \code{drop=TRUE} and \code{i} xor \code{j} missing: the value returned is the matrix that is the more affected by the subset index. That is that \code{x[i, , drop=TRUE]} and \code{x[i, , k, drop=TRUE]} return the basis matrix subset by \code{[i,]} and \code{[i,k]} respectively, while \code{x[, j, drop=TRUE]} and \code{x[, j, k, drop=TRUE]} return the mixture coefficient matrix subset by \code{[,j]} and \code{[k,j]} respectively. } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # create a dummy NMF object that highlight the different way of subsetting a <- nmfModel(W=outer(seq(1,5),10^(0:2)), H=outer(10^(0:2),seq(-1,-10))) basisnames(a) <- paste('b', 1:nbasis(a), sep='') rownames(a) <- paste('f', 1:nrow(a), sep='') colnames(a) <- paste('s', 1:ncol(a), sep='') # or alternatively: # dimnames(a) <- list( features=paste('f', 1:nrow(a), sep='') # , samples=paste('s', 1:ncol(a), sep='') # , basis=paste('b', 1:nbasis(a)) ) # look at the resulting NMF object a basis(a) coef(a) # extract basis components a[1] a[1, drop=FALSE] # not dropping matrix dimension a[2:3] # subset on the features a[1,] a[2:4,] # dropping the NMF-class wrapping => return subset basis matrix a[2:4,, drop=TRUE] # subset on the samples a[,1] a[,2:4] # dropping the NMF-class wrapping => return subset coef matrix a[,2:4, drop=TRUE] # subset on the basis => subsets simultaneously basis and coef matrix a[,,1] a[,,2:3] a[4:5,,2:3] a[4:5,,2:3, drop=TRUE] # return subset basis matrix a[,4:5,2:3, drop=TRUE] # return subset coef matrix # 'drop' has no effect here a[,,2:3, drop=TRUE] } \keyword{methods} NMF/man/revPalette.Rd0000644000176000001440000000032112234465004014073 0ustar ripleyusers\name{revPalette} \alias{revPalette} \title{Flags a Color Palette Specification for Reversion} \usage{ revPalette(x) } \description{ Flags a Color Palette Specification for Reversion } \keyword{internal} NMF/man/rss.Rd0000644000176000001440000001015112305630424012570 0ustar ripleyusers\docType{methods} \name{rss} \alias{evar} \alias{evar,ANY-method} \alias{evar-methods} \alias{rss} \alias{rss,ANY-method} \alias{rss,matrix-method} \alias{rss-methods} \title{Residual Sum of Squares and Explained Variance} \usage{ rss(object, ...) \S4method{rss}{matrix}(object, target) evar(object, ...) \S4method{evar}{ANY}(object, target, ...) } \arguments{ \item{object}{an R object with a suitable \code{\link{fitted}}, \code{rss} or \code{evar} method.} \item{...}{extra arguments to allow extension, e.g. passed to \code{rss} in \code{evar} calls.} \item{target}{target matrix} } \value{ a single numeric value } \description{ \code{rss} and \code{evar} are S4 generic functions that respectively computes the Residual Sum of Squares (RSS) and explained variance achieved by a model. The explained variance for a target \eqn{V} is computed as: \deqn{evar = 1 - \frac{RSS}{\sum_{i,j} v_{ij}^2} }{evar = 1 - RSS/sum v_{ij}^2}, } \details{ where RSS is the residual sum of squares. The explained variance is usefull to compare the performance of different models and their ability to accurately reproduce the original target matrix. Note, however, that a possible caveat is that some models explicitly aim at minimizing the RSS (i.e. maximizing the explained variance), while others do not. } \section{Methods}{ \describe{ \item{evar}{\code{signature(object = "ANY")}: Default method for \code{evar}. It requires a suitable \code{rss} method to be defined for \code{object}, as it internally calls \code{rss(object, target, ...)}. } \item{rss}{\code{signature(object = "matrix")}: Computes the RSS between a target matrix and its estimate \code{object}, which must be a matrix of the same dimensions as \code{target}. The RSS between a target matrix \eqn{V} and its estimate \eqn{v} is computed as: \deqn{RSS = \sum_{i,j} (v_{ij} - V_{ij})^2} Internally, the computation is performed using an optimised C++ implementation, that is light in memory usage. } \item{rss}{\code{signature(object = "ANY")}: Residual sum of square between a given target matrix and a model that has a suitable \code{\link{fitted}} method. It is equivalent to \code{rss(fitted(object), ...)} In the context of NMF, \cite{Hutchins et al. (2008)} used the variation of the RSS in combination with the algorithm from \cite{Lee et al. (1999)} to estimate the correct number of basis vectors. The optimal rank is chosen where the graph of the RSS first shows an inflexion point, i.e. using a screeplot-type criterium. See section \emph{Rank estimation} in \code{\link{nmf}}. Note that this way of estimation may not be suitable for all models. Indeed, if the NMF optimisation problem is not based on the Frobenius norm, the RSS is not directly linked to the quality of approximation of the NMF model. However, it is often the case that it still decreases with the rank. } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } #---------- # rss,matrix-method #---------- # RSS bewteeen random matrices x <- rmatrix(20,10, max=50) y <- rmatrix(20,10, max=50) rss(x, y) rss(x, x + rmatrix(x, max=0.1)) #---------- # rss,ANY-method #---------- # RSS between an NMF model and a target matrix x <- rmatrix(20, 10) y <- rnmf(3, x) # random compatible model rss(y, x) # fit a model with nmf(): one should do better y2 <- nmf(x, 3) # default minimizes the KL-divergence rss(y2, x) y2 <- nmf(x, 3, 'lee') # 'lee' minimizes the RSS rss(y2, x) } \references{ Hutchins LN, Murphy SM, Singh P and Graber JH (2008). "Position-dependent motif characterization using non-negative matrix factorization." _Bioinformatics (Oxford, England)_, *24*(23), pp. 2684-90. ISSN 1367-4811, , . Lee DD and Seung HS (1999). "Learning the parts of objects by non-negative matrix factorization." _Nature_, *401*(6755), pp. 788-91. ISSN 0028-0836, , . } \keyword{methods} NMF/man/show-commaNMFOffset-method.Rd0000644000176000001440000000047112234465004017026 0ustar ripleyusers\docType{methods} \name{show,NMFOffset-method} \alias{show,NMFOffset-method} \title{Show method for objects of class \code{NMFOffset}} \usage{ \S4method{show}{NMFOffset}(object) } \arguments{ \item{object}{Any R object} } \description{ Show method for objects of class \code{NMFOffset} } \keyword{methods} NMF/man/connectivity.Rd0000644000176000001440000001061012305630424014477 0ustar ripleyusers\docType{methods} \name{connectivity} \alias{connectivity} \alias{connectivity,ANY-method} \alias{connectivity,factor-method} \alias{connectivity-methods} \alias{connectivity,NMF-method} \alias{connectivity,numeric-method} \alias{consensus} \alias{consensus-methods} \alias{consensus,NMFfitX-method} \alias{consensus,NMF-method} \title{Clustering Connectivity and Consensus Matrices} \usage{ connectivity(object, ...) \S4method{connectivity}{NMF}(object, no.attrib = FALSE) consensus(object, ...) } \arguments{ \item{object}{an object with a suitable \code{\link{predict}} method.} \item{...}{extra arguments to allow extension. They are passed to \code{\link{predict}}, except for the \code{vector} and \code{factor} methods.} \item{no.attrib}{a logical that indicates if attributes containing information about the NMF model should be attached to the result (\code{TRUE}) or not (\code{FALSE}).} } \value{ a square matrix of dimension the number of samples in the model, full of 0s or 1s. } \description{ \code{connectivity} is an S4 generic that computes the connectivity matrix based on the clustering of samples obtained from a model's \code{\link{predict}} method. The consensus matrix has been proposed by \cite{Brunet et al. (2004)} to help visualising and measuring the stability of the clusters obtained by NMF approaches. For objects of class \code{NMF} (e.g. results of a single NMF run, or NMF models), the consensus matrix reduces to the connectivity matrix. } \details{ The connectivity matrix of a given partition of a set of samples (e.g. given as a cluster membership index) is the matrix \eqn{C} containing only 0 or 1 entries such that: \deqn{C_{ij} = \left\{\begin{array}{l} 1\mbox{ if sample }i\mbox{ belongs to the same cluster as sample }j\\ 0\mbox{ otherwise} \end{array}\right..}{ C_{ij} = 1 if sample i belongs to the same cluster as sample j, 0 otherwise} } \section{Methods}{ \describe{ \item{connectivity}{\code{signature(object = "ANY")}: Default method which computes the connectivity matrix using the result of \code{predict(x, ...)} as cluster membership index. } \item{connectivity}{\code{signature(object = "factor")}: Computes the connectivity matrix using \code{x} as cluster membership index. } \item{connectivity}{\code{signature(object = "numeric")}: Equivalent to \code{connectivity(as.factor(x))}. } \item{connectivity}{\code{signature(object = "NMF")}: Computes the connectivity matrix for an NMF model, for which cluster membership is given by the most contributing basis component in each sample. See \code{\link{predict,NMF-method}}. } \item{consensus}{\code{signature(object = "NMFfitX")}: Pure virtual method defined to ensure \code{consensus} is defined for sub-classes of \code{NMFfitX}. It throws an error if called. } \item{consensus}{\code{signature(object = "NMF")}: This method is provided for completeness and is identical to \code{\link{connectivity}}, and returns the connectivity matrix, which, in the case of a single NMF model, is also the consensus matrix. } \item{consensus}{\code{signature(object = "NMFfitX1")}: The result is the matrix stored in slot \sQuote{consensus}. This method returns \code{NULL} if the consensus matrix is empty. See \code{\link{consensus,NMFfitX1-method}} for more details. } \item{consensus}{\code{signature(object = "NMFfitXn")}: This method returns \code{NULL} on an empty object. The result is a matrix with several attributes attached, that are used by plotting functions such as \code{\link{consensusmap}} to annotate the plots. See \code{\link{consensus,NMFfitXn-method}} for more details. } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } #---------- # connectivity,ANY-method #---------- # clustering of random data h <- hclust(dist(rmatrix(10,20))) connectivity(cutree(h, 2)) #---------- # connectivity,factor-method #---------- connectivity(gl(2, 4)) } \references{ Brunet J, Tamayo P, Golub TR and Mesirov JP (2004). "Metagenes and molecular pattern discovery using matrix factorization." _Proceedings of the National Academy of Sciences of the United States of America_, *101*(12), pp. 4164-9. ISSN 0027-8424, , . } \seealso{ \code{\link{predict}} } \keyword{methods} NMF/man/rmatrix.Rd0000644000176000001440000001075612305630424013462 0ustar ripleyusers\docType{methods} \name{rmatrix} \alias{rmatrix} \alias{rmatrix,ANY-method} \alias{rmatrix-methods} \alias{rmatrix,NMF-method} \alias{rmatrix,numeric-method} \title{Generating Random Matrices} \usage{ rmatrix(x, ...) \S4method{rmatrix}{numeric}(x, y = NULL, dist = runif, byrow = FALSE, dimnames = NULL, ...) } \arguments{ \item{x}{object from which to generate a random matrix} \item{y}{optional specification of number of columns} \item{dist}{a random distribution function or a numeric seed (see details of method \code{rmatrix,numeric})} \item{byrow}{a logical passed in the internal call to the function \code{\link{matrix}}} \item{dimnames}{\code{NULL} or a \code{list} passed in the internal call to the function \code{\link{matrix}}} \item{...}{extra arguments passed to the distribution function \code{dist}.} } \description{ The S4 generic \code{rmatrix} generates a random matrix from a given object. Methods are provided to generate matrices with entries drawn from any given random distribution function, e.g. \code{\link{runif}} or \code{\link{rnorm}}. } \section{Methods}{ \describe{ \item{rmatrix}{\code{signature(x = "numeric")}: Generates a random matrix of given dimensions, whose entries are drawn using the distribution function \code{dist}. This is the workhorse method that is eventually called by all other methods. It returns a matrix with: \itemize{ \item \code{x} rows and \code{y} columns if \code{y} is not missing and not \code{NULL}; \item dimension \code{x[1]} x \code{x[2]} if \code{x} has at least two elements; \item dimension \code{x} (i.e. a square matrix) otherwise. } The default is to draw its entries from the standard uniform distribution using the base function \code{\link{runif}}, but any other function that generates random numeric vectors of a given length may be specified in argument \code{dist}. All arguments in \code{...} are passed to the function specified in \code{dist}. The only requirement is that the function in \code{dist} is of the following form: \samp{ function(n, ...){ # return vector of length n ... }} This is the case of all base random draw function such as \code{\link{rnorm}}, \code{\link{rgamma}}, etc\ldots } \item{rmatrix}{\code{signature(x = "ANY")}: Default method which calls \code{rmatrix,vector} on the dimensions of \code{x} that is assumed to be returned by a suitable \code{dim} method: it is equivalent to \code{rmatrix(dim(x), y=NULL, ...)}. } \item{rmatrix}{\code{signature(x = "NMF")}: Returns the target matrix estimate of the NMF model \code{x}, perturbated by adding a random matrix generated using the default method of \code{rmatrix}: it is a equivalent to \code{fitted(x) + rmatrix(fitted(x), ...)}. This method can be used to generate random target matrices that depart from a known NMF model to a controlled extend. This is useful to test the robustness of NMF algorithms to the presence of certain types of noise in the data. } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } #---------- # rmatrix,numeric-method #---------- ## Generate a random matrix of a given size rmatrix(5, 3) \dontshow{ stopifnot( identical(dim(rmatrix(5, 3)), c(5L,3L)) ) } ## Generate a random matrix of the same dimension of a template matrix a <- matrix(1, 3, 4) rmatrix(a) \dontshow{ stopifnot( identical(dim(rmatrix(a)), c(3L,4L)) ) } ## Specificy the distribution to use # the default is uniform a <- rmatrix(1000, 50) \dontrun{ hist(a) } # use normal ditribution a <- rmatrix(1000, 50, rnorm) \dontrun{ hist(a) } # extra arguments can be passed to the random variate generation function a <- rmatrix(1000, 50, rnorm, mean=2, sd=0.5) \dontrun{ hist(a) } #---------- # rmatrix,ANY-method #---------- # random matrix of the same dimension as another matrix x <- matrix(3,4) dim(rmatrix(x)) #---------- # rmatrix,NMF-method #---------- # generate noisy fitted target from an NMF model (the true model) gr <- as.numeric(mapply(rep, 1:3, 3)) h <- outer(1:3, gr, '==') + 0 x <- rnmf(10, H=h) y <- rmatrix(x) \dontrun{ # show heatmap of the noisy target matrix: block patterns should be clear aheatmap(y) } \dontshow{ stopifnot( identical(dim(y), dim(x)[1:2]) ) } # test NMF algorithm on noisy data # add some noise to the true model (drawn from uniform [0,1]) res <- nmf(rmatrix(x), 3) summary(res) # add more noise to the true model (drawn from uniform [0,10]) res <- nmf(rmatrix(x, max=10), 3) summary(res) } \keyword{methods} NMF/man/parallel.Rd0000644000176000001440000000436412234465004013567 0ustar ripleyusers\name{parallel-NMF} \alias{gVariable} \alias{hostfile} \alias{parallel-NMF} \alias{ts_eval} \alias{ts_tempfile} \title{Utilities for Parallel Computations} \usage{ ts_eval(mutex = synchronicity::boost.mutex(), verbose = FALSE) ts_tempfile(pattern = "file", ..., host = TRUE, pid = TRUE) hostfile(pattern = "file", tmpdir = tempdir(), fileext = "", host = TRUE, pid = TRUE) gVariable(init, shared = FALSE) } \arguments{ \item{mutex}{a mutex or a mutex descriptor. If missing, a new mutex is created via the function \code{\link[synchronicity]{boost.mutex}}.} \item{verbose}{a logical that indicates if messages should be printed when locking and unlocking the mutex.} \item{...}{extra arguments passed to \code{\link[base]{tempfile}}.} \item{host}{logical that indicates if the host machine name should be appear in the filename.} \item{pid}{logical that indicates if the current process id be appear in the filename.} \item{init}{initial value} \item{shared}{a logical that indicates if the variable should be stored in shared memory or in a local environment.} \item{pattern}{a non-empty character vector giving the initial part of the name.} \item{tmpdir}{a non-empty character vector giving the directory name} \item{fileext}{a non-empty character vector giving the file extension} } \description{ Utilities for Parallel Computations \code{ts_eval} generates a thread safe version of \code{\link{eval}}. It uses boost mutexes provided by the \code{\link[synchronicity]{synchronicity}} package. The generated function has arguments \code{expr} and \code{envir}, which are passed to \code{\link{eval}}. \code{ts_tempfile} generates a \emph{unique} temporary filename that includes the name of the host machine and/or the caller's process id, so that it is thread safe. \code{hostfile} generates a temporary filename composed with the name of the host machine and/or the current process id. \code{gVariable} generates a function that access a global static variable, possibly in shared memory (only for numeric matrix-coercible data in this case). It is used primarily in parallel computations, to preserve data accross computations that are performed by the same process. } NMF/man/plot-commaNMFfit-commamissing-method.Rd0000644000176000001440000000443612234465004021051 0ustar ripleyusers\docType{methods} \name{plot,NMFfit,missing-method} \alias{plot,NMFfit,missing-method} \title{Plots the residual track computed at regular interval during the fit of the NMF model \code{x}.} \usage{ \S4method{plot}{NMFfit,missing}(x, y, skip = -1, ...) } \arguments{ \item{skip}{an integer that indicates the number of points to skip/remove from the beginning of the curve. If \code{skip=1L} (default) only the initial residual -- that is computed before any iteration, is skipped, if present in the track (it associated with iteration 0).} \item{x}{the coordinates of points in the plot. Alternatively, a single plotting structure, function or \emph{any \R object with a \code{plot} method} can be provided.} \item{y}{the y coordinates of points in the plot, \emph{optional} if \code{x} is an appropriate structure.} \item{...}{Arguments to be passed to methods, such as \link{graphical parameters} (see \code{\link{par}}). Many methods will accept the following arguments: \describe{ \item{\code{type}}{what type of plot should be drawn. Possible types are \itemize{ \item \code{"p"} for \bold{p}oints, \item \code{"l"} for \bold{l}ines, \item \code{"b"} for \bold{b}oth, \item \code{"c"} for the lines part alone of \code{"b"}, \item \code{"o"} for both \sQuote{\bold{o}verplotted}, \item \code{"h"} for \sQuote{\bold{h}istogram} like (or \sQuote{high-density}) vertical lines, \item \code{"s"} for stair \bold{s}teps, \item \code{"S"} for other \bold{s}teps, see \sQuote{Details} below, \item \code{"n"} for no plotting. } All other \code{type}s give a warning or an error; using, e.g., \code{type = "punkte"} being equivalent to \code{type = "p"} for S compatibility. Note that some methods, e.g. \code{\link{plot.factor}}, do not accept this. } \item{\code{main}}{an overall title for the plot: see \code{\link{title}}.} \item{\code{sub}}{a sub title for the plot: see \code{\link{title}}.} \item{\code{xlab}}{a title for the x axis: see \code{\link{title}}.} \item{\code{ylab}}{a title for the y axis: see \code{\link{title}}.} \item{\code{asp}}{the \eqn{y/x} aspect ratio, see \code{\link{plot.window}}.} } } } \description{ Plots the residual track computed at regular interval during the fit of the NMF model \code{x}. } \keyword{methods} NMF/man/Strategy-class.Rd0000644000176000001440000000327012234470405014674 0ustar ripleyusers\docType{class} \name{Strategy-class} \alias{name} \alias{name<-} \alias{name<--methods} \alias{name-methods} \alias{name<-,Strategy,character-method} \alias{name,Strategy-method} \alias{Strategy-class} \title{Generic Strategy Class} \usage{ name(object, ...) \S4method{name}{Strategy}(object, all = FALSE) name(object, ...)<-value } \arguments{ \item{object}{an R object with a defined \code{name} method} \item{...}{extra arguments to allow extension} \item{value}{replacement value} \item{all}{a logical that indicates if all the names associated with a strategy should be returned (\code{TRUE}), or only the first (primary) one (\code{FALSE}).} } \description{ This class defines a common interface for generic algorithm strategies (e.g., \code{\linkS4class{NMFStrategy}}). \code{name} and \code{name<-} gets and sets the name associated with an object. In the case of \code{Strategy} objects it is the the name of the algorithm. } \section{Slots}{ \describe{ \item{name}{character string giving the name of the algorithm} \item{package}{name of the package that defined the strategy.} \item{defaults}{default values for some of the algorithm's arguments.} } } \section{Methods}{ \describe{ \item{name}{\code{signature(object = "Strategy")}: Returns the name of an algorithm } \item{name}{\code{signature(object = "Strategy")}: Returns the name of an algorithm } \item{name<-}{\code{signature(object = "Strategy", value = "character")}: Sets the name(s) of an NMF algorithm } \item{name<-}{\code{signature(object = "Strategy", value = "character")}: Sets the name(s) of an NMF algorithm } } } \keyword{internal} \keyword{methods} NMF/man/ccPalette.Rd0000644000176000001440000000036312234465004013672 0ustar ripleyusers\name{ccPalette} \alias{ccPalette} \title{Builds a Color Palette from Compact Color Specification} \usage{ ccPalette(x, n = NA, verbose = FALSE) } \description{ Builds a Color Palette from Compact Color Specification } \keyword{internal} NMF/man/offset-commaNMFfit-method.Rd0000644000176000001440000000050312234465004016664 0ustar ripleyusers\docType{methods} \name{offset,NMFfit-method} \alias{offset,NMFfit-method} \title{Returns the offset from the fitted model.} \usage{ \S4method{offset}{NMFfit}(object) } \arguments{ \item{object}{An offset to be included in a model frame} } \description{ Returns the offset from the fitted model. } \keyword{methods} NMF/man/nmf_update_KL.Rd0000644000176000001440000000551612305630424014502 0ustar ripleyusers\name{nmf_update.KL.h} \alias{nmf_update.KL} \alias{nmf_update.KL.h} \alias{nmf_update.KL.h_R} \alias{nmf_update.KL.w} \alias{nmf_update.KL.w_R} \title{NMF Multiplicative Updates for Kullback-Leibler Divergence} \usage{ nmf_update.KL.h(v, w, h, nbterms = 0L, ncterms = 0L, copy = TRUE) nmf_update.KL.h_R(v, w, h, wh = NULL) nmf_update.KL.w(v, w, h, nbterms = 0L, ncterms = 0L, copy = TRUE) nmf_update.KL.w_R(v, w, h, wh = NULL) } \arguments{ \item{v}{target matrix} \item{w}{current basis matrix} \item{h}{current coefficient matrix} \item{nbterms}{number of fixed basis terms} \item{ncterms}{number of fixed coefficient terms} \item{copy}{logical that indicates if the update should be made on the original matrix directly (\code{FALSE}) or on a copy (\code{TRUE} - default). With \code{copy=FALSE} the memory footprint is very small, and some speed-up may be achieved in the case of big matrices. However, greater care should be taken due the side effect. We recommend that only experienced users use \code{copy=TRUE}.} \item{wh}{already computed NMF estimate used to compute the denominator term.} } \value{ a matrix of the same dimension as the input matrix to update (i.e. \code{w} or \code{h}). If \code{copy=FALSE}, the returned matrix uses the same memory as the input object. } \description{ Multiplicative updates from \cite{Lee et al. (2001)} for standard Nonnegative Matrix Factorization models \eqn{V \approx W H}, where the distance between the target matrix and its NMF estimate is measured by the Kullback-Leibler divergence. \code{nmf_update.KL.w} and \code{nmf_update.KL.h} compute the updated basis and coefficient matrices respectively. They use a \emph{C++} implementation which is optimised for speed and memory usage. \code{nmf_update.KL.w_R} and \code{nmf_update.KL.h_R} implement the same updates in \emph{plain R}. } \details{ The coefficient matrix (\code{H}) is updated as follows: \deqn{ H_{kj} \leftarrow H_{kj} \frac{\left( sum_i \frac{W_{ik} V_{ij}}{(WH)_{ij}} \right)}{ sum_i W_{ik} }. }{ H_kj <- H_kj ( sum_i [ W_ik V_ij / (WH)_ij ] ) / ( sum_i W_ik ) } These updates are used in built-in NMF algorithms \code{\link[=KL-nmf]{KL}} and \code{\link[=brunet-nmf]{brunet}}. The basis matrix (\code{W}) is updated as follows: \deqn{ W_{ik} \leftarrow W_{ik} \frac{ sum_j [\frac{H_{kj} A_{ij}}{(WH)_{ij}} ] }{sum_j H_{kj} } }{ W_ik <- W_ik ( sum_u [H_kl A_il / (WH)_il ] ) / ( sum_l H_kl ) } } \author{ Update definitions by \cite{Lee2001}. C++ optimised implementation by Renaud Gaujoux. } \references{ Lee DD and Seung H (2001). "Algorithms for non-negative matrix factorization." _Advances in neural information processing systems_. . } NMF/man/nmfCheck.Rd0000644000176000001440000000154012305630424013501 0ustar ripleyusers\name{nmfCheck} \alias{nmfCheck} \title{Checking NMF Algorithm} \usage{ nmfCheck(method = NULL, rank = max(ncol(x)/5, 3), x = NULL, seed = 1234, ...) } \arguments{ \item{method}{name of the NMF algorithm to be tested.} \item{rank}{rank of the factorization} \item{x}{target data. If \code{NULL}, a random 20 x 10 matrix is generated} \item{seed}{specifies a seed or seeding method for the computation.} \item{...}{other arguments passed to the call to \code{\link{nmf}}.} } \value{ the result of the NMF fit invisibly. } \description{ \code{nmfCheck} enables to quickly check that a given NMF algorithm runs properly, by applying it to some small random data. } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # test default algorithm nmfCheck() # test 'lee' algorithm nmfCheck('lee') } NMF/man/aheatmap.Rd0000644000176000001440000003626712305630424013561 0ustar ripleyusers\name{aheatmap} \alias{aheatmap} \title{Annotated Heatmaps} \usage{ aheatmap(x, color = "-RdYlBu2:100", breaks = NA, border_color = NA, cellwidth = NA, cellheight = NA, scale = "none", Rowv = TRUE, Colv = TRUE, revC = identical(Colv, "Rowv") || is_NA(Rowv) || (is.integer(Rowv) && length(Rowv) > 1) || is(Rowv, "silhouette"), distfun = "euclidean", hclustfun = "complete", reorderfun = function(d, w) reorder(d, w), treeheight = 50, legend = TRUE, annCol = NA, annRow = NA, annColors = NA, annLegend = TRUE, labRow = NULL, labCol = NULL, subsetRow = NULL, subsetCol = NULL, txt = NULL, fontsize = 10, cexRow = min(0.2 + 1/log10(nr), 1.2), cexCol = min(0.2 + 1/log10(nc), 1.2), filename = NA, width = NA, height = NA, main = NULL, sub = NULL, info = NULL, verbose = getOption("verbose"), gp = gpar()) } \arguments{ \item{x}{numeric matrix of the values to be plotted. An \code{\link[Biobase:ExpressionSet-class]{ExpressionSet}} objects can also be passed, in which case the expression values are plotted (\code{exprs(x)}).} \item{color}{colour specification for the heatmap. Default to palette '-RdYlBu2:100', i.e. reversed palette 'RdYlBu2' (a slight modification of RColorBrewer's palette 'RdYlBu') with 100 colors. Possible values are: \itemize{ \item a character/integer vector of length greater than 1 that is directly used and assumed to contain valid R color specifications. \item a single color/integer (between 0 and 8)/other numeric value that gives the dominant colors. Numeric values are converted into a pallete by \code{rev(sequential_hcl(2, h = x, l = c(50, 95)))}. Other values are concatenated with the grey colour '#F1F1F1'. \item one of RColorBrewer's palette name (see \code{\link[RColorBrewer]{display.brewer.all}}) , or one of 'RdYlBu2', 'rainbow', 'heat', 'topo', 'terrain', 'cm'. } When the coluor palette is specified with a single value, and is negative or preceded a minus ('-'), the reversed palette is used. The number of breaks can also be specified after a colon (':'). For example, the default colour palette is specified as '-RdYlBu2:100'.} \item{breaks}{a sequence of numbers that covers the range of values in \code{x} and is one element longer than color vector. Used for mapping values to colors. Useful, if needed to map certain values to certain colors. If value is NA then the breaks are calculated automatically. If \code{breaks} is a single value, then the colour palette is centered on this value.} \item{border_color}{color of cell borders on heatmap, use NA if no border should be drawn.} \item{cellwidth}{individual cell width in points. If left as NA, then the values depend on the size of plotting window.} \item{cellheight}{individual cell height in points. If left as NA, then the values depend on the size of plotting window.} \item{scale}{character indicating how the values should scaled in either the row direction or the column direction. Note that the scaling is performed after row/column clustering, so that it has no effect on the row/column ordering. Possible values are: \itemize{ \item \code{"row"}: center and standardize each row separately to row Z-scores \item \code{"column"}: center and standardize each column separately to column Z-scores \item \code{"r1"}: scale each row to sum up to one \item \code{"c1"}: scale each column to sum up to one \item \code{"none"}: no scaling }} \item{Rowv}{clustering specification(s) for the rows. It allows to specify the distance/clustering/ordering/display parameters to be used for the \emph{rows only}. Possible values are: \itemize{ \item \code{TRUE} or \code{NULL} (to be consistent with \code{\link{heatmap}}): compute a dendrogram from hierarchical clustering using the distance and clustering methods \code{distfun} and \code{hclustfun}. \item \code{NA}: disable any ordering. In this case, and if not otherwise specified with argument \code{revC=FALSE}, the heatmap shows the input matrix with the rows in their original order, with the first row on top to the last row at the bottom. Note that this differ from the behaviour or \code{\link{heatmap}}, but seemed to be a more sensible choice when vizualizing a matrix without reordering. \item an integer vector of length the number of rows of the input matrix (\code{nrow(x)}), that specifies the row order. As in the case \code{Rowv=NA}, the ordered matrix is shown first row on top, last row at the bottom. \item a character vector or a list specifying values to use instead of arguments \code{distfun}, \code{hclustfun} and \code{reorderfun} when clustering the rows (see the respective argument descriptions for a list of accepted values). If \code{Rowv} has no names, then the first element is used for \code{distfun}, the second (if present) is used for \code{hclustfun}, and the third (if present) is used for \code{reorderfun}. \item a numeric vector of weights, of length the number of rows of the input matrix, used to reorder the internally computed dendrogram \code{d} by \code{reorderfun(d, Rowv)}. \item \code{FALSE}: the dendrogram \emph{is} computed using methods \code{distfun}, \code{hclustfun}, and \code{reorderfun} but is not shown. \item a single integer that specifies how many subtrees (i.e. clusters) from the computed dendrogram should have their root faded out. This can be used to better highlight the different clusters. \item a single double that specifies how much space is used by the computed dendrogram. That is that this value is used in place of \code{treeheight}. }} \item{Colv}{clustering specification(s) for the columns. It accepts the same values as argument \code{Rowv} (modulo the expected length for vector specifications), and allow specifying the distance/clustering/ordering/display parameters to be used for the \emph{columns only}. \code{Colv} may also be set to \code{"Rowv"}, in which case the dendrogram or ordering specifications applied to the rows are also applied to the columns. Note that this is allowed only for square input matrices, and that the row ordering is in this case by default reversed (\code{revC=TRUE}) to obtain the diagonal in the standard way (from top-left to bottom-right). See argument \code{Rowv} for other possible values.} \item{revC}{a logical that specify if the \emph{row order} defined by \code{Rowv} should be reversed. This is mainly used to get the rows displayed from top to bottom, which is not the case by default. Its default value is computed at runtime, to suit common situations where natural ordering is a more sensible choice: no or fix ordering of the rows (\code{Rowv=NA} or an integer vector of indexes -- of length > 1), and when a symmetric ordering is requested -- so that the diagonal is shown as expected. An argument in favor of the "odd" default display (bottom to top) is that the row dendrogram is plotted from bottom to top, and reversing its reorder may take a not too long but non negligeable time.} \item{distfun}{default distance measure used in clustering rows and columns. Possible values are: \itemize{ \item all the distance methods supported by \code{\link{dist}} (e.g. "euclidean" or "maximum"). \item all correlation methods supported by \code{\link{cor}}, such as \code{"pearson"} or \code{"spearman"}. The pairwise distances between rows/columns are then computed as \code{d <- dist(1 - cor(..., method = distfun))}. One may as well use the string "correlation" which is an alias for "pearson". \item an object of class \code{dist} such as returned by \code{\link{dist}} or \code{\link{as.dist}}. }} \item{hclustfun}{default clustering method used to cluster rows and columns. Possible values are: \itemize{ \item a method name (a character string) supported by \code{\link{hclust}} (e.g. \code{'average'}). \item an object of class \code{hclust} such as returned by \code{\link{hclust}} \item a dendrogram }} \item{reorderfun}{default dendrogram reordering function, used to reorder the dendrogram, when either \code{Rowv} or \code{Colv} is a numeric weight vector, or provides or computes a dendrogram. It must take 2 parameters: a dendrogram, and a weight vector.} \item{subsetRow}{Specification of subsetting the rows before drawing the heatmap. Possible values are: \itemize{ \item an integer vector of length > 1 specifying the indexes of the rows to keep; \item a character vector of length > 1 specyfing the names of the rows to keep. These are the original rownames, not the names specified in \code{labRow}. \item a logical vector of length > 1, whose elements are recycled if the vector has not as many elements as rows in \code{x}. } Note that in the case \code{Rowv} is a dendrogram or hclust object, it is first converted into an ordering vector, and cannot be displayed -- and a warning is thrown.} \item{subsetCol}{Specification of subsetting the columns before drawing the heatmap. It accepts the similar values as \code{subsetRow}. See details above.} \item{txt}{character matrix of the same size as \code{x}, that contains text to display in each cell. \code{NA} values are allowed and are not displayed. See demo for an example.} \item{treeheight}{how much space (in points) should be used to display dendrograms. If specified as a single value, it is used for both dendrograms. A length-2 vector specifies separate values for the row and column dendrogram respectively. Default value: 50 points.} \item{legend}{boolean value that determines if a colour ramp for the heatmap's colour palette should be drawn or not. Default is \code{TRUE}.} \item{annCol}{specifications of column annotation tracks displayed as coloured rows on top of the heatmaps. The annotation tracks are drawn from bottom to top. A single annotation track can be specified as a single vector; multiple tracks are specified as a list, a data frame, or an \code{\link[Biobase:ExpressionSet-class]{ExpressionSet}} object, in which case the phenotypic data is used (\code{pData(eset)}). Character or integer vectors are converted and displayed as factors. Unnamed tracks are internally renamed into \code{Xi}, with i being incremented for each unamed track, across both column and row annotation tracks. For each track, if no corresponding colour is specified in argument \code{annColors}, a palette or a ramp is automatically computed and named after the track's name.} \item{annRow}{specifications of row annotation tracks displayed as coloured columns on the left of the heatmaps. The annotation tracks are drawn from left to right. The same conversion, renaming and colouring rules as for argument \code{annCol} apply.} \item{annColors}{list for specifying annotation track colors manually. It is possible to define the colors for only some of the annotations. Check examples for details.} \item{annLegend}{boolean value specifying if the legend for the annotation tracks should be drawn or not. Default is \code{TRUE}.} \item{labRow}{labels for the rows.} \item{labCol}{labels for the columns. See description for argument \code{labRow} for a list of the possible values.} \item{fontsize}{base fontsize for the plot} \item{cexRow}{fontsize for the rownames, specified as a fraction of argument \code{fontsize}.} \item{cexCol}{fontsize for the colnames, specified as a fraction of argument \code{fontsize}.} \item{main}{Main title as a character string or a grob.} \item{sub}{Subtitle as a character string or a grob.} \item{info}{(experimental) Extra information as a character vector or a grob. If \code{info=TRUE}, information about the clustering methods is displayed at the bottom of the plot.} \item{filename}{file path ending where to save the picture. Currently following formats are supported: png, pdf, tiff, bmp, jpeg. Even if the plot does not fit into the plotting window, the file size is calculated so that the plot would fit there, unless specified otherwise.} \item{width}{manual option for determining the output file width in} \item{height}{manual option for determining the output file height in inches.} \item{verbose}{if \code{TRUE} then verbose messages are displayed and the borders of some viewports are highlighted. It is entended for debugging purposes.} \item{gp}{graphical parameters for the text used in plot. Parameters passed to \code{\link{grid.text}}, see \code{\link{gpar}}.} } \description{ The function \code{aheatmap} plots high-quality heatmaps, with a detailed legend and unlimited annotation tracks for both columns and rows. The annotations are coloured differently according to their type (factor or numeric covariate). Although it uses grid graphics, the generated plot is compatible with base layouts such as the ones defined with \code{'mfrow'} or \code{\link{layout}}, enabling the easy drawing of multiple heatmaps on a single a plot -- at last!. } \details{ The development of this function started as a fork of the function \code{pheatmap} from the \pkg{pheatmap} package, and provides several enhancements such as: \itemize{ \item argument names match those used in the base function \code{\link{heatmap}}; \item unlimited number of annotation for \strong{both} columns and rows, with simplified and more flexible interface; \item easy specification of clustering methods and colors; \item return clustering data, as well as grid grob object. } Please read the associated vignette for more information and sample code. } \section{PDF graphic devices}{ if plotting on a PDF graphic device -- started with \code{\link{pdf}}, one may get generate a first blank page, due to internals of standard functions from the \pkg{grid} package that are called by \code{aheatmap}. The \pkg{NMF} package ships a custom patch that fixes this issue. However, in order to comply with CRAN policies, the patch is \strong{not} applied by default and the user must explicitly be enabled it. This can be achieved on runtime by either setting the NMF specific option 'grid.patch' via \code{nmf.options(grid.patch=TRUE)}, or on load time if the environment variable 'R_PACKAGE_NMF_GRID_PATCH' is defined and its value is something that is not equivalent to \code{FALSE} (i.e. not '', 'false' nor 0). } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } ## See the demo 'aheatmap' for more examples: \dontrun{ demo('aheatmap') } # Generate random data n <- 50; p <- 20 x <- abs(rmatrix(n, p, rnorm, mean=4, sd=1)) x[1:10, seq(1, 10, 2)] <- x[1:10, seq(1, 10, 2)] + 3 x[11:20, seq(2, 10, 2)] <- x[11:20, seq(2, 10, 2)] + 2 rownames(x) <- paste("ROW", 1:n) colnames(x) <- paste("COL", 1:p) ## Default heatmap aheatmap(x) ## Distance methods aheatmap(x, Rowv = "correlation") aheatmap(x, Rowv = "man") # partially matched to 'manhattan' aheatmap(x, Rowv = "man", Colv="binary") # Generate column annotations annotation = data.frame(Var1 = factor(1:p \%\% 2 == 0, labels = c("Class1", "Class2")), Var2 = 1:10) aheatmap(x, annCol = annotation) } \author{ Original version of \code{pheatmap}: Raivo Kolde Enhancement into \code{aheatmap}: Renaud Gaujoux } NMF/man/utils.Rd0000644000176000001440000000105412305630424013123 0ustar ripleyusers\name{utils-NMF} \alias{str_args} \alias{utils-NMF} \title{Utility Function in the NMF Package} \usage{ str_args(x, exdent = 10L) } \arguments{ \item{x}{a function} \item{exdent}{indentation for extra lines if the output takes more than one line.} } \description{ Utility Function in the NMF Package \code{str_args} formats the arguments of a function using \code{\link{args}}, but returns the output as a string. } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } args(library) str_args(library) } NMF/man/rnmf.Rd0000644000176000001440000003231112305630424012725 0ustar ripleyusers\docType{methods} \name{rnmf} \alias{rnmf} \alias{rnmf,ANY,data.frame-method} \alias{rnmf,ANY,matrix-method} \alias{rnmf,formula,ANY-method} \alias{rnmf-methods} \alias{rnmf,missing,missing-method} \alias{rnmf,NMF,missing-method} \alias{rnmf,NMF,numeric-method} \alias{rnmf,NMFOffset,numeric-method} \alias{rnmf,numeric,missing-method} \alias{rnmf,numeric,numeric-method} \title{Generating Random NMF Models} \usage{ rnmf(x, target, ...) \S4method{rnmf}{NMF,numeric}(x, target, ncol = NULL, keep.names = TRUE, dist = runif) \S4method{rnmf}{ANY,matrix}(x, target, ..., dist = list(max = max(max(target, na.rm = TRUE), 1)), use.dimnames = TRUE) \S4method{rnmf}{numeric,missing}(x, target, ..., W, H, dist = runif) \S4method{rnmf}{missing,missing}(x, target, ..., W, H) \S4method{rnmf}{numeric,numeric}(x, target, ncol = NULL, ..., dist = runif) \S4method{rnmf}{formula,ANY}(x, target, ..., dist = runif) } \arguments{ \item{x}{an object that determines the rank, dimension and/or class of the generated NMF model, e.g. a numeric value or an object that inherits from class \code{\linkS4class{NMF}}. See the description of the specific methods for more details on the supported types.} \item{target}{optional specification of target dimensions. See section \emph{Methods} for how this parameter is used by the different methods.} \item{...}{extra arguments to allow extensions and passed to the next method eventually down to \code{\link{nmfModel}}, where they are used to initialise slots that are specific to the instantiating NMF model.} \item{ncol}{single numeric value that specifies the number of columns of the coefficient matrix. Only used when \code{target} is a single numeric value.} \item{keep.names}{a logical that indicates if the dimension names of the original NMF object \code{x} should be conserved (\code{TRUE}) or discarded (\code{FALSE}).} \item{dist}{specification of the random distribution to use to draw the entries of the basis and coefficient matrices. It may be specified as: \itemize{ \item a \code{function} which must be a distribution function such as e.g. \code{\link{runif}} that is used to draw the entries of both the basis and coefficient matrices. It is passed in the \code{dist} argument of \code{\link{rmatrix}}. \item a \code{list} of arguments that are passed internally to \code{\link{rmatrix}}, via \code{do.call('rmatrix', dist)}. \item a \code{character} string that is partially matched to \sQuote{basis} or \sQuote{coef}, that specifies which matrix in should be drawn randomly, the other remaining as in \code{x} -- unchanged. \item a \code{list} with elements \sQuote{basis} and/or \sQuote{coef}, which specify the \code{dist} argument separately for the basis and coefficient matrix respectively. These elements may be either a distribution function, or a list of arguments that are passed internally to \code{\link{rmatrix}}, via \code{do.call('rmatrix', dist$basis)} or \code{do.call('rmatrix', dist$coef)}. }} \item{use.dimnames}{a logical that indicates whether the dimnames of the target matrix should be set on the returned NMF model.} \item{W}{value for the basis matrix. \code{data.frame} objects are converted into matrices with \code{\link{as.matrix}}.} \item{H}{value for the mixture coefficient matrix \code{data.frame} objects are converted into matrices with \code{\link{as.matrix}}.} } \value{ An NMF model, i.e. an object that inherits from class \code{\linkS4class{NMF}}. } \description{ Generates NMF models with random values drawn from a uniform distribution. It returns an NMF model with basis and mixture coefficient matrices filled with random values. The main purpose of the function \code{rnmf} is to provide a common interface to generate random seeds used by the \code{\link{nmf}} function. } \details{ If necessary, extensions of the standard NMF model or custom models must define a method "rnmf,,numeric" for initialising their specific slots other than the basis and mixture coefficient matrices. In order to benefit from the complete built-in interface, the overloading methods should call the generic version using function \code{\link{callNextMethod}}, prior to set the values of the specific slots. See for example the method \code{\link[=rnmf,NMFOffset,numeric-method]{rnmf}} defined for \code{\linkS4class{NMFOffset}} models: \code{showMethods(rnmf, class='NMFOffset', include=TRUE))}. For convenience, shortcut methods for working on \code{data.frame} objects directly are implemented. However, note that conversion of a \code{data.frame} into a \code{matrix} object may take some non-negligible time, for large datasets. If using this method or other NMF-related methods several times, consider converting your data \code{data.frame} object into a matrix once for good, when first loaded. } \section{Methods}{ \describe{ \item{rnmf}{\code{signature(x = "NMFOffset", target = "numeric")}: Generates a random NMF model with offset, from class \code{NMFOffset}. The offset values are drawn from a uniform distribution between 0 and the maximum entry of the basis and coefficient matrices, which are drawn by the next suitable \code{\link{rnmf}} method, which is the workhorse method \code{rnmf,NMF,numeric}. } \item{rnmf}{\code{signature(x = "NMF", target = "numeric")}: Generates a random NMF model of the same class and rank as another NMF model. This is the workhorse method that is eventually called by all other methods. It generates an NMF model of the same class and rank as \code{x}, compatible with the dimensions specified in \code{target}, that can be a single or 2-length numeric vector, to specify a square or rectangular target matrix respectively. The second dimension can also be passed via argument \code{ncol}, so that calling \code{rnmf(x, 20, 10, ...)} is equivalent to \code{rnmf(x, c(20, 10), ...)}, but easier to write. The entries are uniformly drawn between \code{0} and \code{max} (optionally specified in \code{...}) that defaults to 1. By default the dimnames of \code{x} are set on the returned NMF model. This behaviour is disabled with argument \code{keep.names=FALSE}. See \code{\link{nmfModel}}. } \item{rnmf}{\code{signature(x = "ANY", target = "matrix")}: Generates a random NMF model compatible and consistent with a target matrix. The entries are uniformly drawn between \code{0} and \code{max(target)}. It is more or less a shortcut for: \samp{ rnmf(x, dim(target), max=max(target), ...)} It returns an NMF model of the same class as \code{x}. } \item{rnmf}{\code{signature(x = "ANY", target = "data.frame")}: Shortcut for \code{rnmf(x, as.matrix(target))}. } \item{rnmf}{\code{signature(x = "NMF", target = "missing")}: Generates a random NMF model of the same dimension as another NMF model. It is a shortcut for \code{rnmf(x, nrow(x), ncol(x), ...)}, which returns a random NMF model of the same class and dimensions as \code{x}. } \item{rnmf}{\code{signature(x = "numeric", target = "missing")}: Generates a random NMF model of a given rank, with known basis and/or coefficient matrices. This methods allow to easily generate partially random NMF model, where one or both factors are known. Although the later case might seems strange, it makes sense for NMF models that have fit extra data, other than the basis and coefficient matrices, that are drawn by an \code{rnmf} method defined for their own class, which should internally call \code{rnmf,NMF,numeric} and let it draw the basis and coefficient matrices. (e.g. see \code{\linkS4class{NMFOffset}} and \code{\link{rnmf,NMFOffset,numeric-method}}). Depending on whether arguments \code{W} and/or \code{H} are missing, this method interprets \code{x} differently: \itemize{ \item \code{W} provided, \code{H} missing: \code{x} is taken as the number of columns that must be drawn to build a random coefficient matrix (i.e. the number of columns in the target matrix). \item \code{W} is missing, \code{H} is provided: \code{x} is taken as the number of rows that must be drawn to build a random basis matrix (i.e. the number of rows in the target matrix). \item both \code{W} and \code{H} are provided: \code{x} is taken as the target rank of the model to generate. \item Having both \code{W} and \code{H} missing produces an error, as the dimension of the model cannot be determined in this case. } The matrices \code{W} and \code{H} are reduced if necessary and possible to be consistent with this value of the rank, by the internal call to \code{\link{nmfModel}}. All arguments in \code{...} are passed to the function \code{\link{nmfModel}} which is used to build an initial NMF model, that is in turn passed to \code{rnmf,NMF,numeric} with \code{dist=list(coef=dist)} or \code{dist=list(basis=dist)} when suitable. The type of NMF model to generate can therefore be specified in argument \code{model} (see \code{\link{nmfModel}} for other possible arguments). The returned NMF model, has a basis matrix equal to \code{W} (if not missing) and a coefficient matrix equal to \code{H} (if not missing), or drawn according to the specification provided in argument \code{dist} (see method \code{rnmf,NMF,numeric} for details on the supported values for \code{dist}). } \item{rnmf}{\code{signature(x = "missing", target = "missing")}: Generates a random NMF model with known basis and coefficient matrices. This method is a shortcut for calling \code{rnmf,numeric,missing} with a suitable value for \code{x} (the rank), when both factors are known: code{rnmf(min(ncol(W), nrow(H)), ..., W=W, H=H)}. Arguments \code{W} and \code{H} are required. Note that calling this method only makes sense for NMF models that contains data to fit other than the basis and coefficient matrices, e.g. \code{\linkS4class{NMFOffset}}. } \item{rnmf}{\code{signature(x = "numeric", target = "numeric")}: Generates a random standard NMF model of given dimensions. This is a shortcut for \code{rnmf(nmfModel(x, target, ncol, ...)), dist=dist)}. It generates a standard NMF model compatible with the dimensions passed in \code{target}, that can be a single or 2-length numeric vector, to specify a square or rectangular target matrix respectively. See \code{\link{nmfModel}}. } \item{rnmf}{\code{signature(x = "formula", target = "ANY")}: Generate a random formula-based NMF model, using the method \code{\link{nmfModel,formula,ANY-method}}. } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } #---------- # rnmf,NMFOffset,numeric-method #---------- # random NMF model with offset x <- rnmf(2, 3, model='NMFOffset') x offset(x) # from a matrix x <- rnmf(2, rmatrix(5,3, max=10), model='NMFOffset') offset(x) #---------- # rnmf,NMF,numeric-method #---------- ## random NMF of same class and rank as another model x <- nmfModel(3, 10, 5) x rnmf(x, 20) # square rnmf(x, 20, 13) rnmf(x, c(20, 13)) # using another distribution rnmf(x, 20, dist=rnorm) # other than standard model y <- rnmf(3, 50, 10, model='NMFns') y \dontshow{ stopifnot( identical(dim(y), c(50L,10L,3L)) ) } \dontshow{ stopifnot( is(y, 'NMFns') ) } #---------- # rnmf,ANY,matrix-method #---------- # random NMF compatible with a target matrix x <- nmfModel(3, 10, 5) y <- rmatrix(20, 13) rnmf(x, y) # rank of x rnmf(2, y) # rank 2 #---------- # rnmf,NMF,missing-method #---------- ## random NMF from another model a <- nmfModel(3, 100, 20) b <- rnmf(a) \dontshow{ stopifnot( !nmf.equal(a,b) ) } #---------- # rnmf,numeric,missing-method #---------- # random NMF model with known basis matrix x <- rnmf(5, W=matrix(1:18, 6)) # 6 x 5 model with rank=3 basis(x) # fixed coef(x) # random # random NMF model with known coefficient matrix x <- rnmf(5, H=matrix(1:18, 3)) # 5 x 6 model with rank=3 basis(x) # random coef(x) # fixed # random model other than standard NMF x <- rnmf(5, H=matrix(1:18, 3), model='NMFOffset') basis(x) # random coef(x) # fixed offset(x) # random #---------- # rnmf,missing,missing-method #---------- # random model other than standard NMF x <- rnmf(W=matrix(1:18, 6), H=matrix(21:38, 3), model='NMFOffset') basis(x) # fixed coef(x) # fixed offset(x) # random #---------- # rnmf,numeric,numeric-method #---------- ## random standard NMF of given dimensions # generate a random NMF model with rank 3 that fits a 100x20 matrix rnmf(3, 100, 20) \dontshow{ stopifnot( identical(dim(rnmf(3, 100, 20)), c(100L,20L,3L)) ) } # generate a random NMF model with rank 3 that fits a 100x100 matrix rnmf(3, 100) \dontshow{ stopifnot( identical(dim(rnmf(3, 100)), c(100L,100L,3L)) ) } } \seealso{ \code{\link{rmatrix}} Other NMF-interface: \code{\link{basis}}, \code{\link{.basis}}, \code{\link{.basis<-}}, \code{\link{basis<-}}, \code{\link{coef}}, \code{\link{.coef}}, \code{\link{.coef<-}}, \code{\link{coef<-}}, \code{\link{coefficients}}, \code{\link{.DollarNames,NMF-method}}, \code{\link{loadings,NMF-method}}, \code{\link{misc}}, \code{\link{NMF-class}}, \code{\link{$<-,NMF-method}}, \code{\link{$,NMF-method}}, \code{\link{nmfModel}}, \code{\link{nmfModels}}, \code{\link{scoef}} } \keyword{methods} NMF/man/assess.Rd0000644000176000001440000001062012305630424013263 0ustar ripleyusers\docType{methods} \name{summary} \alias{summary} \alias{summary-methods} \alias{summary-NMF} \alias{summary,NMFfit-method} \alias{summary,NMFfitX-method} \alias{summary,NMF-method} \title{Assessing and Comparing NMF Models} \usage{ summary(object, ...) \S4method{summary}{NMF}(object, class, target) } \arguments{ \item{object}{an NMF object. See available methods in section \emph{Methods}.} \item{...}{extra arguments passed to the next \code{summary} method.} \item{class}{known classes/cluster of samples specified in one of the formats that is supported by the functions \code{\link{entropy}} and \code{\link{purity}}.} \item{target}{target matrix specified in one of the formats supported by the functions \code{\link{rss}} and \code{\link{evar}}} } \description{ The NMF package defines \code{summary} methods for different classes of objects, which helps assessing and comparing the quality of NMF models by computing a set of quantitative measures, e.g. with respect to their ability to recover known classes and/or the original target matrix. The most useful methods are for classes \code{\linkS4class{NMF}}, \code{\linkS4class{NMFfit}}, \code{\linkS4class{NMFfitX}} and \code{\linkS4class{NMFList}}, which compute summary measures for, respectively, a single NMF model, a single fit, a multiple-run fit and a list of heterogenous fits performed with the function \code{\link{nmf}}. } \details{ Due to the somehow hierarchical structure of the classes mentionned in \emph{Description}, their respective \code{summary} methods call each other in chain, each super-class adding some extra measures, only relevant for objects of a specific class. } \section{Methods}{ \describe{ \item{summary}{\code{signature(object = "NMF")}: Computes summary measures for a single NMF model. The following measures are computed: \describe{ \item{sparseness}{Sparseness of the factorization computed by the function \code{\link{sparseness}}.} \item{entropy}{Purity of the clustering, with respect to known classes, computed by the function \code{\link{purity}}.} \item{entropy}{Entropy of the clustering, with respect to known classes, computed by the function \code{\link{entropy}}.} \item{RSS}{Residual Sum of Squares computed by the function \code{\link{rss}}.} \item{evar}{Explained variance computed by the function \code{\link{evar}}.} } } \item{summary}{\code{signature(object = "NMFfit")}: Computes summary measures for a single fit from \code{\link{nmf}}. This method adds the following measures to the measures computed by the method \code{summary,NMF}: \describe{ \item{residuals}{Residual error as measured by the objective function associated to the algorithm used to fit the model.} \item{niter}{Number of iterations performed to achieve convergence of the algorithm.} \item{cpu}{Total CPU time required for the fit.} \item{cpu.all}{Total CPU time required for the fit. For \code{NMFfit} objects, this element is always equal to the value in \dQuote{cpu}, but will be different for multiple-run fits.} \item{nrun}{Number of runs performed to fit the model. This is always equal to 1 for \code{NMFfit} objects, but will vary for multiple-run fits.} } } \item{summary}{\code{signature(object = "NMFfitX")}: Computes a set of measures to help evaluate the quality of the \emph{best fit} of the set. The result is similar to the result from the \code{summary} method of \code{NMFfit} objects. See \code{\linkS4class{NMF}} for details on the computed measures. In addition, the cophenetic correlation (\code{\link{cophcor}}) and \code{\link{dispersion}} coefficients of the consensus matrix are returned, as well as the total CPU time (\code{\link{runtime.all}}). } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } #---------- # summary,NMF-method #---------- # random NMF model x <- rnmf(3, 20, 12) summary(x) summary(x, gl(3, 4)) summary(x, target=rmatrix(x)) summary(x, gl(3,4), target=rmatrix(x)) #---------- # summary,NMFfit-method #---------- # generate a synthetic dataset with known classes: 50 features, 18 samples (5+5+8) n <- 50; counts <- c(5, 5, 8); V <- syntheticNMF(n, counts) cl <- unlist(mapply(rep, 1:3, counts)) # perform default NMF with rank=2 x2 <- nmf(V, 2) summary(x2, cl, V) # perform default NMF with rank=2 x3 <- nmf(V, 3) summary(x2, cl, V) } \keyword{methods} NMF/man/cutdendro.Rd0000644000176000001440000000042212234465004013751 0ustar ripleyusers\name{cutdendro} \alias{cutdendro} \title{Fade Out the Upper Branches from a Dendrogram} \usage{ cutdendro(x, n) } \arguments{ \item{x}{a dendrogram} \item{n}{the number of groups} } \description{ Fade Out the Upper Branches from a Dendrogram } \keyword{internal} NMF/man/predict.Rd0000644000176000001440000001161212305630424013416 0ustar ripleyusers\docType{methods} \name{predict} \alias{predict} \alias{predict-methods} \alias{predict,NMFfitX-method} \alias{predict,NMF-method} \title{Clustering and Prediction} \usage{ predict(object, ...) \S4method{predict}{NMF}(object, what = c("columns", "rows", "samples", "features"), prob = FALSE, dmatrix = FALSE) \S4method{predict}{NMFfitX}(object, what = c("columns", "rows", "samples", "features", "consensus", "chc"), dmatrix = FALSE, ...) } \arguments{ \item{object}{an NMF model} \item{what}{a character string that indicates the type of cluster membership should be returned: \sQuote{columns} or \sQuote{rows} for clustering the colmuns or the rows of the target matrix respectively. The values \sQuote{samples} and \sQuote{features} are aliases for \sQuote{colmuns} and \sQuote{rows} respectively.} \item{prob}{logical that indicates if the relative contributions of/to the dominant basis component should be computed and returned. See \emph{Details}.} \item{dmatrix}{logical that indicates if a dissimiliarity matrix should be attached to the result. This is notably used internally when computing NMF clustering silhouettes.} \item{...}{additional arguments affecting the predictions produced.} } \description{ The methods \code{predict} for NMF models return the cluster membership of each sample or each feature. Currently the classification/prediction of new data is not implemented. } \details{ The cluster membership is computed as the index of the dominant basis component for each sample (\code{what='samples' or 'columns'}) or each feature (\code{what='features' or 'rows'}), based on their corresponding entries in the coefficient matrix or basis matrix respectively. For example, if \code{what='samples'}, then the dominant basis component is computed for each column of the coefficient matrix as the row index of the maximum within the column. If argument \code{prob=FALSE} (default), the result is a \code{factor}. Otherwise a list with two elements is returned: element \code{predict} contains the cluster membership index (as a \code{factor}) and element \code{prob} contains the relative contribution of the dominant component to each sample (resp. the relative contribution of each feature to the dominant basis component): \itemize{ \item Samples: \deqn{p_j = x_{k_0} / \sum_k x_k}{p(j) = x(k0) / sum_k x(k)}, for each sample \eqn{1\leq j \leq p}, where \eqn{x_k}{x(k)} is the contribution of the \eqn{k}-th basis component to \eqn{j}-th sample (i.e. \code{H[k ,j]}), and \eqn{x_{k_0}}{x(k0)} is the maximum of these contributions. \item Features: \deqn{p_i = y_{k_0} / \sum_k y_k}{p(i) = y(k0) / sum_k y(k)}, for each feature \eqn{1\leq i \leq p}, where \eqn{y_k}{y(k)} is the contribution of the \eqn{k}-th basis component to \eqn{i}-th feature (i.e. \code{W[i, k]}), and \eqn{y_{k_0}}{y(k0)} is the maximum of these contributions. } } \section{Methods}{ \describe{ \item{predict}{\code{signature(object = "NMF")}: Default method for NMF models } \item{predict}{\code{signature(object = "NMFfitX")}: Returns the cluster membership index from an NMF model fitted with multiple runs. Besides the type of clustering available for any NMF models (\code{'columns', 'rows', 'samples', 'features'}), this method can return the cluster membership index based on the consensus matrix, computed from the multiple NMF runs. Argument \code{what} accepts the following extra types: \describe{ \item{\code{'chc'}}{ returns the cluster membership based on the hierarchical clustering of the consensus matrix, as performed by \code{\link{consensushc}}.} \item{\code{'consensus'}}{ same as \code{'chc'} but the levels of the membership index are re-labeled to match the order of the clusters as they would be displayed on the associated dendrogram, as re-ordered on the default annotation track in consensus heatmap produced by \code{\link{consensusmap}}.} } } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # random target matrix v <- rmatrix(20, 10) # fit an NMF model x <- nmf(v, 5) # predicted column and row clusters predict(x) predict(x, 'rows') # with relative contributions of each basis component predict(x, prob=TRUE) predict(x, 'rows', prob=TRUE) } \references{ Brunet J, Tamayo P, Golub TR and Mesirov JP (2004). "Metagenes and molecular pattern discovery using matrix factorization." _Proceedings of the National Academy of Sciences of the United States of America_, *101*(12), pp. 4164-9. ISSN 0027-8424, , . Pascual-Montano A, Carazo JM, Kochi K, Lehmann D and Pascual-marqui RD (2006). "Nonsmooth nonnegative matrix factorization (nsNMF)." _IEEE Trans. Pattern Anal. Mach. Intell_, *28*, pp. 403-415. } \keyword{methods} NMF/man/randomize.Rd0000644000176000001440000000153312305630424013755 0ustar ripleyusers\name{randomize} \alias{randomize} \title{Randomizing Data} \usage{ randomize(x, ...) } \arguments{ \item{x}{data to be permutated. It must be an object suitable to be passed to the function \code{\link{apply}}.} \item{...}{extra arguments passed to the function \code{\link{sample}}.} } \value{ a matrix } \description{ \code{randomize} permutates independently the entries in each column of a matrix-like object, to produce random data that can be used in permutation tests or bootstrap analysis. } \details{ In the context of NMF, it may be used to generate random data, whose factorization serves as a reference for selecting a factorization rank, that does not overfit the data. } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } x <- matrix(1:32, 4, 8) randomize(x) randomize(x) } NMF/man/algorithm-commaNMFStrategyOctave-method.Rd0000644000176000001440000000124412234465004021551 0ustar ripleyusers\docType{methods} \name{algorithm,NMFStrategyOctave-method} \alias{algorithm,NMFStrategyOctave-method} \title{Returns the name of the Octave/Matlab function that implements the NMF algorithm -- as stored in slot \code{algorithm}.} \usage{ \S4method{algorithm}{NMFStrategyOctave}(object, load = FALSE) } \arguments{ \item{load}{logical that indicates if the algorithm should be loaded as an R function.} \item{object}{an object computed using some algorithm, or that describes an algorithm itself.} } \description{ Returns the name of the Octave/Matlab function that implements the NMF algorithm -- as stored in slot \code{algorithm}. } \keyword{methods} NMF/man/NMFStrategyIterative-class.Rd0000644000176000001440000000473212234465004017115 0ustar ripleyusers\docType{class} \name{NMFStrategyIterative-class} \alias{NMFStrategyIterative-class} \title{Interface for Algorithms: Implementation for Iterative NMF Algorithms} \description{ This class provides a specific implementation for the generic function \code{run} -- concretising the virtual interface class \code{\linkS4class{NMFStrategy}}, for NMF algorithms that conform to the following iterative schema (starred numbers indicate mandatory steps): \itemize{ \item 1. Initialisation \item 2*. Update the model at each iteration \item 3. Stop if some criterion is satisfied \item 4. Wrap up } This schema could possibly apply to all NMF algorithms, since these are essentially optimisation algorithms, almost all of which use iterative methods to approximate a solution of the optimisation problem. The main advantage is that it allows to implement updates and stopping criterion separately, and combine them in different ways. In particular, many NMF algorithms are based on multiplicative updates, following the approach from \cite{Lee et al. (2001)}, which are specially suitable to be cast into this simple schema. } \section{Slots}{ \describe{ \item{onInit}{optional function that performs some initialisation or pre-processing on the model, before starting the iteration loop.} \item{Update}{mandatory function that implement the update step, which computes new values for the model, based on its previous value. It is called at each iteration, until the stopping criterion is met or the maximum number of iteration is achieved.} \item{Stop}{optional function that implements the stopping criterion. It is called \strong{before} each Update step. If not provided, the iterations are stopped after a fixed number of updates.} \item{onReturn}{optional function that wraps up the result into an NMF object. It is called just before returning the} } } \section{Methods}{ \describe{ \item{run}{\code{signature(object = "NMFStrategyIterative", y = "matrix", x = "NMFfit")}: Runs an NMF iterative algorithm on a target matrix \code{y}. } \item{show}{\code{signature(object = "NMFStrategyIterative")}: Show method for objects of class \code{NMFStrategyIterative} } } } \references{ Lee DD and Seung H (2001). "Algorithms for non-negative matrix factorization." _Advances in neural information processing systems_. . } NMF/man/NMF-defunct.Rd0000644000176000001440000000157612234465004014043 0ustar ripleyusers\docType{methods} \name{NMF-defunct} \alias{metaHeatmap} \alias{metaHeatmap,matrix-method} \alias{metaHeatmap-methods} \alias{metaHeatmap,NMFfitX-method} \alias{metaHeatmap,NMF-method} \alias{NMF-defunct} \title{Defunct Functions and Classes in the NMF Package} \usage{ metaHeatmap(object, ...) } \arguments{ \item{object}{an R object} \item{...}{other arguments} } \description{ Defunct Functions and Classes in the NMF Package } \section{Methods}{ \describe{ \item{metaHeatmap}{\code{signature(object = "matrix")}: Defunct method substituted by \code{\link{aheatmap}}. } \item{metaHeatmap}{\code{signature(object = "NMF")}: Deprecated method that is substituted by \code{\link{coefmap}} and \code{\link{basismap}}. } \item{metaHeatmap}{\code{signature(object = "NMFfitX")}: Deprecated method subsituted by \code{\link{consensusmap}}. } } } \keyword{methods} NMF/man/nmf_update_euclidean.Rd0000644000176000001440000000647412305630424016131 0ustar ripleyusers\name{nmf_update.euclidean.h} \alias{nmf_update.euclidean} \alias{nmf_update.euclidean.h} \alias{nmf_update.euclidean.h_R} \alias{nmf_update.euclidean.w} \alias{nmf_update.euclidean.w_R} \title{NMF Multiplicative Updates for Euclidean Distance} \usage{ nmf_update.euclidean.h(v, w, h, eps = 10^-9, nbterms = 0L, ncterms = 0L, copy = TRUE) nmf_update.euclidean.h_R(v, w, h, wh = NULL, eps = 10^-9) nmf_update.euclidean.w(v, w, h, eps = 10^-9, nbterms = 0L, ncterms = 0L, weight = NULL, copy = TRUE) nmf_update.euclidean.w_R(v, w, h, wh = NULL, eps = 10^-9) } \arguments{ \item{eps}{small numeric value used to ensure numeric stability, by shifting up entries from zero to this fixed value.} \item{wh}{already computed NMF estimate used to compute the denominator term.} \item{weight}{numeric vector of sample weights, e.g., used to normalise samples coming from multiple datasets. It must be of the same length as the number of samples/columns in \code{v} -- and \code{h}.} \item{v}{target matrix} \item{w}{current basis matrix} \item{h}{current coefficient matrix} \item{nbterms}{number of fixed basis terms} \item{ncterms}{number of fixed coefficient terms} \item{copy}{logical that indicates if the update should be made on the original matrix directly (\code{FALSE}) or on a copy (\code{TRUE} - default). With \code{copy=FALSE} the memory footprint is very small, and some speed-up may be achieved in the case of big matrices. However, greater care should be taken due the side effect. We recommend that only experienced users use \code{copy=TRUE}.} } \value{ a matrix of the same dimension as the input matrix to update (i.e. \code{w} or \code{h}). If \code{copy=FALSE}, the returned matrix uses the same memory as the input object. } \description{ Multiplicative updates from \cite{Lee et al. (2001)} for standard Nonnegative Matrix Factorization models \eqn{V \approx W H}, where the distance between the target matrix and its NMF estimate is measured by the -- euclidean -- Frobenius norm. \code{nmf_update.euclidean.w} and \code{nmf_update.euclidean.h} compute the updated basis and coefficient matrices respectively. They use a \emph{C++} implementation which is optimised for speed and memory usage. \code{nmf_update.euclidean.w_R} and \code{nmf_update.euclidean.h_R} implement the same updates in \emph{plain R}. } \details{ The coefficient matrix (\code{H}) is updated as follows: \deqn{ H_{kj} \leftarrow \frac{\max(H_{kj} W^T V)_{kj}, \varepsilon) }{(W^T W H)_{kj} + \varepsilon} }{ H_kj <- max(H_kj (W^T V)_kj, eps) / ( (W^T W H)_kj + eps ) } These updates are used by the built-in NMF algorithms \code{\link[=Frobenius-nmf]{Frobenius}} and \code{\link[=lee-nmf]{lee}}. The basis matrix (\code{W}) is updated as follows: \deqn{ W_ik \leftarrow \frac{\max(W_ik (V H^T)_ik, \varepsilon) }{ (W H H^T)_ik + \varepsilon} }{ W_ik <- max(W_ik (V H^T)_ik, eps) / ( (W H H^T)_ik + eps ) } } \author{ Update definitions by \cite{Lee2001}. C++ optimised implementation by Renaud Gaujoux. } \references{ Lee DD and Seung H (2001). "Algorithms for non-negative matrix factorization." _Advances in neural information processing systems_. . } NMF/man/options.Rd0000644000176000001440000001144212305630424013460 0ustar ripleyusers\name{options-NMF} \alias{nmf.getOption} \alias{nmf.options} \alias{nmf.printOptions} \alias{nmf.resetOptions} \alias{options-NMF} \title{NMF Package Specific Options} \usage{ nmf.options(...) nmf.getOption(x, default = NULL) nmf.resetOptions(..., ALL = FALSE) nmf.printOptions() } \arguments{ \item{...}{option specifications. For \code{nmf.options} this can be named arguments or a single unnamed argument that is a named list (see \code{\link{options}}. For \code{nmf.resetOptions}, this must be the names of the options to reset. Note that \pkg{pkgmaker} version >= 0.9.1 is required for this to work correctly, when options other than the default ones have been set after the package is loaded.} \item{ALL}{logical that indicates if options that are not part of the default set of options should be removed. Note that in \pkg{pkgmaker <= 0.9} this argument is only taken into account when no other argument is present. This is fixed in version 0.9.1.} \item{x}{a character string holding an option name.} \item{default}{if the specified option is not set in the options list, this value is returned. This facilitates retrieving an option and checking whether it is set and setting it separately if not.} } \description{ NMF Package Specific Options \code{nmf.options} sets/get single or multiple options, that are specific to the NMF package. It behaves in the same way as \code{\link[base]{options}}. \code{nmf.getOption} returns the value of a single option, that is specific to the NMF package. It behaves in the same way as \code{\link[base]{getOption}}. \code{nmf.resetOptions} reset all NMF specific options to their default values. \code{nmf.printOptions} prints all NMF specific options along with their default values, in a relatively compact way. } \section{Available options}{ \describe{ \item{cores}{Default number of cores to use to perform parallel NMF computations. Note that this option is effectively used only if the global option \code{'cores'} is not set. Moreover, the number of cores can also be set at runtime, in the call to \code{\link{nmf}}, via arguments \code{.pbackend} or \code{.options} (see \code{\link{nmf}} for more details).} \item{default.algorithm}{Default NMF algorithm used by the \code{nmf} function when argument \code{method} is missing. The value should the key of one of the registered NMF algorithms or a valid specification of an NMF algorithm. See \code{?nmfAlgorithm}.} \item{default.seed}{Default seeding method used by the \code{nmf} function when argument \code{seed} is missing. The value should the key of one of the registered seeding methods or a vallid specification of a seeding method. See \code{?nmfSeed}.} \item{track}{Toggle default residual tracking. When \code{TRUE}, the \code{nmf} function compute and store the residual track in the result -- if not otherwise specified in argument \code{.options}. Note that tracking may significantly slow down the computations.} \item{track.interval}{Number of iterations between two points in the residual track. This option is relevant only when residual tracking is enabled. See \code{?nmf}.} \item{error.track}{this is a symbolic link to option \code{track} for backward compatibility.} \item{pbackend}{Default loop/parallel foreach backend used by the \code{nmf} function when argument \code{.pbackend} is missing. Currently the following values are supported: \code{'par'} for multicore, \code{'seq'} for sequential, \code{NA} for standard \code{sapply} (i.e. do not use a foreach loop), \code{NULL} for using the currently registered foreach backend.} \item{parallel.backend}{this is a symbolic link to option \code{pbackend} for backward compatibility.} \item{gc}{Interval/frequency (in number of runs) at which garbage collection is performed.} \item{verbose}{Default level of verbosity.} \item{debug}{Toogles debug mode. In this mode the console output may be very -- very -- messy, and is aimed at debugging only.} \item{maxIter}{ Default maximum number of iteration to use (default NULL). This option is for internal/technical usage only, to globally speed up examples or tests of NMF algorithms. To be used with care at one's own risk... It is documented here so that advanced users are aware of its existence, and can avoid possible conflict with their own custom options. } } % end description } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # show all NMF specific options nmf.printOptions() # get some options nmf.getOption('verbose') nmf.getOption('pbackend') # set new values nmf.options(verbose=TRUE) nmf.options(pbackend='mc', default.algorithm='lee') nmf.printOptions() # reset to default nmf.resetOptions() nmf.printOptions() } NMF/man/nneg.Rd0000644000176000001440000001230712305630424012715 0ustar ripleyusers\docType{methods} \name{nneg} \alias{nneg} \alias{nneg,matrix-method} \alias{nneg-methods} \alias{nneg,NMF-method} \alias{posneg} \alias{rposneg} \alias{rposneg,matrix-method} \alias{rposneg-methods} \alias{rposneg,NMF-method} \title{Transforming from Mixed-sign to Nonnegative Data} \usage{ nneg(object, ...) \S4method{nneg}{matrix}(object, method = c("pmax", "posneg", "absolute", "min"), threshold = 0, shift = TRUE) posneg(...) rposneg(object, ...) \S4method{rposneg}{matrix}(object, unstack = TRUE) } \arguments{ \item{object}{The data object to transform} \item{...}{extra arguments to allow extension or passed down to \code{nneg,matrix} or \code{rposneg,matrix} in subsequent calls.} \item{method}{Name of the transformation method to use, that is partially matched against the following possible methods: \describe{ \item{pmax}{Each entry is constrained to be above threshold \code{threshold}.} \item{posneg}{The matrix is split into its "positive" and "negative" parts, with the entries of each part constrained to be above threshold \code{threshold}. The result consists in these two parts stacked in rows (i.e. \code{\link{rbind}}-ed) into a single matrix, which has double the number of rows of the input matrix \code{object}.} \item{absolute}{The absolute value of each entry is constrained to be above threshold \code{threshold}.} \item{min}{Global shift by adding the minimum entry to each entry, only if it is negative, and then apply threshold. } }} \item{threshold}{Nonnegative lower threshold value (single numeric). See argument \code{shit} for details on how the threshold is used and affects the result.} \item{shift}{a logical indicating whether the entries below the threshold value \code{threshold} should be forced (shifted) to 0 (default) or to the threshold value itself. In other words, if \code{shift=TRUE} (default) all entries in the result matrix are either 0 or strictly greater than \code{threshold}. They are all greater or equal than \code{threshold} otherwise.} \item{unstack}{Logical indicating whether the positive and negative parts should be unstacked and combined into a matrix as \code{pos - neg}, which contains half the number of rows of \code{object} (default), or left stacked as \code{[pos; -neg]}.} } \value{ an object of the same class as argument \code{object}. an object of the same type of \code{object} } \description{ \code{nneg} is a generic function to transform a data objects that contains negative values into a similar object that only contains values that are nonnegative or greater than a given threshold. \code{posneg} is a shortcut for \code{nneg(..., method='posneg')}, to split mixed-sign data into its positive and negative part. See description for method \code{"posneg"}, in \code{\link{nneg}}. \code{rposneg} performs the "reverse" transformation of the \code{\link{posneg}} function. } \section{Methods}{ \describe{ \item{nneg}{\code{signature(object = "matrix")}: Transforms a mixed-sign matrix into a nonnegative matrix, optionally apply a lower threshold. This is the workhorse method, that is eventually called by all other methods defined in the \code{\link{NMF}} package. } \item{nneg}{\code{signature(object = "NMF")}: Apply \code{nneg} to the basis matrix of an \code{\link{NMF}} object (i.e. \code{basis(object)}). All extra arguments in \code{...} are passed to the method \code{nneg,matrix}. } \item{rposneg}{\code{signature(object = "NMF")}: Apply \code{rposneg} to the basis matrix of an \code{\link{NMF}} object. } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } #---------- # nneg,matrix-method #---------- # random mixed sign data (normal distribution) set.seed(1) x <- rmatrix(5,5, rnorm, mean=0, sd=5) x # pmax (default) nneg(x) # using a threshold nneg(x, threshold=2) # without shifting the entries lower than threshold nneg(x, threshold=2, shift=FALSE) # posneg: split positive and negative part nneg(x, method='posneg') nneg(x, method='pos', threshold=2) # absolute nneg(x, method='absolute') nneg(x, method='abs', threshold=2) # min nneg(x, method='min') nneg(x, method='min', threshold=2) #---------- # nneg,NMF-method #---------- # random M <- nmfModel(x, rmatrix(ncol(x), 3)) nnM <- nneg(M) basis(nnM) # mixture coefficients are not affected identical( coef(M), coef(nnM) ) #---------- # posneg #---------- # shortcut for the "posneg" transformation posneg(x) posneg(x, 2) #---------- # rposneg,matrix-method #---------- # random mixed sign data (normal distribution) set.seed(1) x <- rmatrix(5,5, rnorm, mean=0, sd=5) x # posneg-transform: split positive and negative part y <- posneg(x) dim(y) # posneg-reverse z <- rposneg(y) identical(x, z) rposneg(y, unstack=FALSE) # But posneg-transformation with a non zero threshold is not reversible y1 <- posneg(x, 1) identical(rposneg(y1), x) #---------- # rposneg,NMF-method #---------- # random mixed signed NMF model M <- nmfModel(rmatrix(10, 3, rnorm), rmatrix(3, 4)) # split positive and negative part nnM <- posneg(M) M2 <- rposneg(nnM) identical(M, M2) } \seealso{ \code{\link{pmax}} Other transforms: \code{\link{t.NMF}} } \keyword{methods} NMF/man/ccSpec.Rd0000644000176000001440000000045212234465004013165 0ustar ripleyusers\name{ccSpec} \alias{ccSpec} \title{Extract Colour Palette Specification} \usage{ ccSpec(x) } \arguments{ \item{a}{character string that specify a colour palette.} } \value{ a list with elements: palette, n and rev } \description{ Extract Colour Palette Specification } \keyword{internal} NMF/man/NMF-class.Rd0000644000176000001440000004113612305630424013513 0ustar ripleyusers\docType{class} \name{NMF-class} \alias{.DollarNames,NMF-method} \alias{misc} \alias{NMF-class} \alias{$<-,NMF-method} \alias{$,NMF-method} \title{Generic Interface for Nonnegative Matrix Factorisation Models} \usage{ misc(object, ...) \S4method{$}{NMF}(x, name) \S4method{$}{NMF}(x, name)<-value \S4method{.DollarNames}{NMF}(x, pattern = "") } \arguments{ \item{object}{an object that inherit from class \code{NMF}} \item{...}{extra arguments (not used)} \item{x}{ object from which to extract element(s) or in which to replace element(s). } \item{name}{ A literal character string or a \link{name} (possibly \link{backtick} quoted). For extraction, this is normally (see under \sQuote{Environments}) partially matched to the \code{\link{names}} of the object. } \item{value}{typically an array-like \R object of a similar class as \code{x}.} \item{pattern}{ A regular expression. Only matching names are returned. } } \description{ The class \code{NMF} is a \emph{virtual class} that defines a common interface to handle Nonnegative Matrix Factorization models (NMF models) in a generic way. Provided a minimum set of generic methods is implemented by concrete model classes, these benefit from a whole set of functions and utilities to perform common computations and tasks in the context of Nonnegative Matrix Factorization. The function \code{misc} provides access to miscellaneous data members stored in slot \code{misc} (as a \code{list}), which allow extensions of NMF models to be implemented, without defining a new S4 class. } \details{ Class \code{NMF} makes it easy to develop new models that integrate well into the general framework implemented by the \emph{NMF} package. Following a few simple guidelines, new types of NMF models benefit from all the functionalities available for the built-in NMF models -- that derive themselves from class \code{NMF}. See section \emph{Implementing NMF models} below. See \code{\linkS4class{NMFstd}}, and references and links therein for details on the built-in implementations of the standard NMF model and its extensions. } \section{Slots}{ \describe{ \item{misc}{A list that is used internally to temporarily store algorithm parameters during the computation.} } } \section{Methods}{ \describe{ \item{[}{\code{signature(x = "NMF")}: This method provides a convenient way of sub-setting objects of class \code{NMF}, using a matrix-like syntax. It allows to consistently subset one or both matrix factors in the NMF model, as well as retrieving part of the basis components or part of the mixture coefficients with a reduced amount of code. See \code{\link{[,NMF-method}} for more details. } \item{$}{\code{signature(x = "NMF")}: shortcut for \code{x@misc[[name, exact=TRUE]]} respectively. } \item{$}{\code{signature(x = "NMF")}: shortcut for \code{x@misc[[name, exact=TRUE]]} respectively. } \item{$<-}{\code{signature(x = "NMF")}: shortcut for \code{x@misc[[name]] <- value} } \item{$<-}{\code{signature(x = "NMF")}: shortcut for \code{x@misc[[name]] <- value} } \item{.basis}{\code{signature(object = "NMF")}: Pure virtual method for objects of class \code{\linkS4class{NMF}}, that should be overloaded by sub-classes, and throws an error if called. } \item{.basis<-}{\code{signature(object = "NMF", value = "matrix")}: Pure virtual method for objects of class \code{\linkS4class{NMF}}, that should be overloaded by sub-classes, and throws an error if called. } \item{basis<-}{\code{signature(object = "NMF")}: Default methods that calls \code{.basis<-} and check the validity of the updated object. } \item{basiscor}{\code{signature(x = "NMF", y = "matrix")}: Computes the correlations between the basis vectors of \code{x} and the columns of \code{y}. } \item{basiscor}{\code{signature(x = "NMF", y = "NMF")}: Computes the correlations between the basis vectors of \code{x} and \code{y}. } \item{basiscor}{\code{signature(x = "NMF", y = "missing")}: Computes the correlations between the basis vectors of \code{x}. } \item{basismap}{\code{signature(object = "NMF")}: Plots a heatmap of the basis matrix of the NMF model \code{object}. This method also works for fitted NMF models (i.e. \code{NMFfit} objects). } \item{c}{\code{signature(x = "NMF")}: Binds compatible matrices and NMF models together. } \item{.coef}{\code{signature(object = "NMF")}: Pure virtual method for objects of class \code{\linkS4class{NMF}}, that should be overloaded by sub-classes, and throws an error if called. } \item{.coef<-}{\code{signature(object = "NMF", value = "matrix")}: Pure virtual method for objects of class \code{\linkS4class{NMF}}, that should be overloaded by sub-classes, and throws an error if called. } \item{coef<-}{\code{signature(object = "NMF")}: Default methods that calls \code{.coef<-} and check the validity of the updated object. } \item{coefficients}{\code{signature(object = "NMF")}: Alias to \code{coef,NMF}, therefore also pure virtual. } \item{coefmap}{\code{signature(object = "NMF")}: The default method for NMF objects has special default values for some arguments of \code{\link{aheatmap}} (see argument description). } \item{connectivity}{\code{signature(object = "NMF")}: Computes the connectivity matrix for an NMF model, for which cluster membership is given by the most contributing basis component in each sample. See \code{\link{predict,NMF-method}}. } \item{consensus}{\code{signature(object = "NMF")}: This method is provided for completeness and is identical to \code{\link{connectivity}}, and returns the connectivity matrix, which, in the case of a single NMF model, is also the consensus matrix. } \item{consensushc}{\code{signature(object = "NMF")}: Compute the hierarchical clustering on the connectivity matrix of \code{object}. } \item{consensusmap}{\code{signature(object = "NMF")}: Plots a heatmap of the connectivity matrix of an NMF model. } \item{deviance}{\code{signature(object = "NMF")}: Computes the distance between a matrix and the estimate of an \code{NMF} model. } \item{dim}{\code{signature(x = "NMF")}: method for NMF objects for the base generic \code{\link{dim}}. It returns all dimensions in a length-3 integer vector: the number of row and columns of the estimated target matrix, as well as the factorization rank (i.e. the number of basis components). } \item{dimnames}{\code{signature(x = "NMF")}: Returns the dimension names of the NMF model \code{x}. It returns either NULL if no dimnames are set on the object, or a 3-length list containing the row names of the basis matrix, the column names of the mixture coefficient matrix, and the column names of the basis matrix (i.e. the names of the basis components). } \item{dimnames<-}{\code{signature(x = "NMF")}: sets the dimension names of the NMF model \code{x}. \code{value} can be \code{NULL} which resets all dimension names, or a 1, 2 or 3-length list providing names at least for the rows of the basis matrix. See \code{\link{dimnames<-,NMF-method}} for more details. } \item{.DollarNames}{\code{signature(x = "NMF")}: Auto-completion for \code{\linkS4class{NMF}} objects } \item{.DollarNames}{\code{signature(x = "NMF")}: Auto-completion for \code{\linkS4class{NMF}} objects } \item{extractFeatures}{\code{signature(object = "NMF")}: Select basis-specific features from an NMF model, by applying the method \code{extractFeatures,matrix} to its basis matrix. } \item{featureScore}{\code{signature(object = "NMF")}: Computes feature scores on the basis matrix of an NMF model. } \item{fitted}{\code{signature(object = "NMF")}: Pure virtual method for objects of class \code{\linkS4class{NMF}}, that should be overloaded by sub-classes, and throws an error if called. } \item{ibterms}{\code{signature(object = "NMF")}: Default pure virtual method that ensure a method is defined for concrete NMF model classes. } \item{icterms}{\code{signature(object = "NMF")}: Default pure virtual method that ensure a method is defined for concrete NMF model classes. } \item{loadings}{\code{signature(x = "NMF")}: Method loadings for NMF Models The method \code{loadings} is identical to \code{basis}, but do not accept any extra argument. See \code{\link{loadings,NMF-method}} for more details. } \item{metaHeatmap}{\code{signature(object = "NMF")}: Deprecated method that is substituted by \code{\link{coefmap}} and \code{\link{basismap}}. } \item{nmf.equal}{\code{signature(x = "NMF", y = "NMF")}: Compares two NMF models. Arguments in \code{...} are used only when \code{identical=FALSE} and are passed to \code{all.equal}. } \item{nmf.equal}{\code{signature(x = "NMF", y = "NMFfit")}: Compares two NMF models when at least one comes from a NMFfit object, i.e. an object returned by a single run of \code{\link{nmf}}. } \item{nmf.equal}{\code{signature(x = "NMF", y = "NMFfitX")}: Compares two NMF models when at least one comes from multiple NMF runs. } \item{nneg}{\code{signature(object = "NMF")}: Apply \code{nneg} to the basis matrix of an \code{\link{NMF}} object (i.e. \code{basis(object)}). All extra arguments in \code{...} are passed to the method \code{nneg,matrix}. } \item{predict}{\code{signature(object = "NMF")}: Default method for NMF models } \item{profcor}{\code{signature(x = "NMF", y = "matrix")}: Computes the correlations between the basis profiles of \code{x} and the rows of \code{y}. } \item{profcor}{\code{signature(x = "NMF", y = "NMF")}: Computes the correlations between the basis profiles of \code{x} and \code{y}. } \item{profcor}{\code{signature(x = "NMF", y = "missing")}: Computes the correlations between the basis profiles of \code{x}. } \item{rmatrix}{\code{signature(x = "NMF")}: Returns the target matrix estimate of the NMF model \code{x}, perturbated by adding a random matrix generated using the default method of \code{rmatrix}: it is a equivalent to \code{fitted(x) + rmatrix(fitted(x), ...)}. This method can be used to generate random target matrices that depart from a known NMF model to a controlled extend. This is useful to test the robustness of NMF algorithms to the presence of certain types of noise in the data. } \item{rnmf}{\code{signature(x = "NMF", target = "numeric")}: Generates a random NMF model of the same class and rank as another NMF model. This is the workhorse method that is eventually called by all other methods. It generates an NMF model of the same class and rank as \code{x}, compatible with the dimensions specified in \code{target}, that can be a single or 2-length numeric vector, to specify a square or rectangular target matrix respectively. See \code{\link{rnmf,NMF,numeric-method}} for more details. } \item{rnmf}{\code{signature(x = "NMF", target = "missing")}: Generates a random NMF model of the same dimension as another NMF model. It is a shortcut for \code{rnmf(x, nrow(x), ncol(x), ...)}, which returns a random NMF model of the same class and dimensions as \code{x}. } \item{rposneg}{\code{signature(object = "NMF")}: Apply \code{rposneg} to the basis matrix of an \code{\link{NMF}} object. } \item{show}{\code{signature(object = "NMF")}: Show method for objects of class \code{NMF} } \item{sparseness}{\code{signature(x = "NMF")}: Compute the sparseness of an object of class \code{NMF}, as the sparseness of the basis and coefficient matrices computed separately. It returns the two values in a numeric vector with names \sQuote{basis} and \sQuote{coef}. } \item{summary}{\code{signature(object = "NMF")}: Computes summary measures for a single NMF model. The following measures are computed: See \code{\link{summary,NMF-method}} for more details. } } } \section{Implementing NMF models}{ The class \code{NMF} only defines a basic data/low-level interface for NMF models, as a collection of generic methods, responsible with data handling, upon which relies a comprehensive set of functions, composing a rich higher-level interface. Actual NMF models are defined as sub-classes that inherits from class \code{NMF}, and implement the management of data storage, providing definitions for the interface's pure virtual methods. The minimum requirement to define a new NMF model that integrates into the framework of the \emph{NMF} package are the followings: \itemize{ \item Define a class that inherits from class \code{NMF} and implements the new model, say class \code{myNMF}. \item Implement the following S4 methods for the new class \code{myNMF}: \describe{ \item{fitted}{\code{signature(object = "myNMF", value = "matrix")}: Must return the estimated target matrix as fitted by the NMF model \code{object}. } \item{basis}{\code{signature(object = "myNMF")}: Must return the basis matrix(e.g. the first matrix factor in the standard NMF model). } \item{basis<-}{\code{signature(object = "myNMF", value = "matrix")}: Must return \code{object} with the basis matrix set to \code{value}. } \item{coef}{\code{signature(object = "myNMF")}: Must return the matrix of mixture coefficients (e.g. the second matrix factor in the standard NMF model). } \item{coef<-}{\code{signature(object = "myNMF", value = "matrix")}: Must return \code{object} with the matrix of mixture coefficients set to \code{value}. } } The \emph{NMF} package provides "pure virtual" definitions of these methods for class \code{NMF} (i.e. with signatures \code{(object='NMF', ...)} and \code{(object='NMF', value='matrix')}) that throw an error if called, so as to force their definition for model classes. \item Optionally, implement method \code{rnmf}(signature(x="myNMF", target="ANY")). This method should call \code{callNextMethod(x=x, target=target, ...)} and fill the returned NMF model with its specific data suitable random values. } For concrete examples of NMF models implementations, see class \code{\linkS4class{NMFstd}} and its extensions (e.g. classes \code{\linkS4class{NMFOffset}} or \code{\linkS4class{NMFns}}). } \section{Creating NMF objects}{ Strictly speaking, because class \code{NMF} is virtual, no object of class \code{NMF} can be instantiated, only objects from its sub-classes. However, those objects are sometimes shortly referred in the documentation and vignettes as "\code{NMF} objects" instead of "objects that inherits from class \code{NMF}". For built-in models or for models that inherit from the standard model class \code{\linkS4class{NMFstd}}, the factory method \code{nmfModel} enables to easily create valid \code{NMF} objects in a variety of common situations. See documentation for the the factory method \code{\link{nmfModel}} for more details. } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # show all the NMF models available (i.e. the classes that inherit from class NMF) nmfModels() # show all the built-in NMF models available nmfModels(builtin.only=TRUE) # class NMF is a virtual class so cannot be instantiated: try( new('NMF') ) # To instantiate an NMF model, use the factory method nmfModel. see ?nmfModel nmfModel() nmfModel(3) nmfModel(3, model='NMFns') } \references{ Definition of Nonnegative Matrix Factorization in its modern formulation: \cite{Lee et al. (1999)} Historical first definition and algorithms: \cite{Paatero et al. (1994)} Lee DD and Seung HS (1999). "Learning the parts of objects by non-negative matrix factorization." _Nature_, *401*(6755), pp. 788-91. ISSN 0028-0836, , . Paatero P and Tapper U (1994). "Positive matrix factorization: A non-negative factor model with optimal utilization of error estimates of data values." _Environmetrics_, *5*(2), pp. 111-126. , . } \seealso{ Main interface to perform NMF in \code{\link{nmf-methods}}. Built-in NMF models and factory method in \code{\link{nmfModel}}. Method \code{\link{seed}} to set NMF objects with values suitable to start algorithms with. Other NMF-interface: \code{\link{basis}}, \code{\link{.basis}}, \code{\link{.basis<-}}, \code{\link{basis<-}}, \code{\link{coef}}, \code{\link{.coef}}, \code{\link{.coef<-}}, \code{\link{coef<-}}, \code{\link{coefficients}}, \code{\link{loadings,NMF-method}}, \code{\link{nmfModel}}, \code{\link{nmfModels}}, \code{\link{rnmf}}, \code{\link{scoef}} } \keyword{methods} NMF/man/SNMF-nmf.Rd0000644000176000001440000000546112234465004013313 0ustar ripleyusers\name{nmfAlgorithm.SNMF_R} \alias{nmfAlgorithm.SNMF_L} \alias{nmfAlgorithm.SNMF_R} \alias{SNMF/L-nmf} \alias{SNMF/R-nmf} \title{NMF Algorithm - Sparse NMF via Alternating NNLS} \usage{ nmfAlgorithm.SNMF_R(..., maxIter = 20000L, eta = -1, beta = 0.01, bi_conv = c(0, 10), eps_conv = 1e-04) nmfAlgorithm.SNMF_L(..., maxIter = 20000L, eta = -1, beta = 0.01, bi_conv = c(0, 10), eps_conv = 1e-04) } \arguments{ \item{maxIter}{maximum number of iterations.} \item{eta}{parameter to suppress/bound the L2-norm of \code{W} and in \code{H} in \sQuote{SNMF/R} and \sQuote{SNMF/L} respectively. If \code{eta < 0}, then it is set to the maximum value in the target matrix is used.} \item{beta}{regularisation parameter for sparsity control, which balances the trade-off between the accuracy of the approximation and the sparseness of \code{H} and \code{W} in \sQuote{SNMF/R} and \sQuote{SNMF/L} respectively. Larger beta generates higher sparseness on \code{H} (resp. \code{W}). Too large beta is not recommended.} \item{bi_conv}{parameter of the biclustering convergence test. It must be a size 2 numeric vector \code{bi_conv=c(wminchange, iconv)}, with: \describe{ \item{\code{wminchange}:}{the minimal allowance of change in row-clusters.} \item{\code{iconv}:}{ decide convergence if row-clusters (within the allowance of \code{wminchange}) and column-clusters have not changed for \code{iconv} convergence checks.} } Convergence checks are performed every 5 iterations.} \item{eps_conv}{threshold for the KKT convergence test.} \item{...}{extra argument not used.} } \description{ NMF algorithms proposed by \cite{Kim et al. (2007)} that enforces sparsity constraint on the basis matrix (algorithm \sQuote{SNMF/L}) or the mixture coefficient matrix (algorithm \sQuote{SNMF/R}). } \details{ The algorithm \sQuote{SNMF/R} solves the following NMF optimization problem on a given target matrix \eqn{A} of dimension \eqn{n \times p}{n x p}: \deqn{ \begin{array}{ll} & \min_{W,H} \frac{1}{2} \left(|| A - WH ||_F^2 + \eta ||W||_F^2 + \beta (\sum_{j=1}^p ||H_{.j}||_1^2)\right)\\ s.t. & W\geq 0, H\geq 0 \end{array} }{ min_{W,H} 1/2 (|| A - WH ||_F^2 + eta ||W||_F^2 + beta (sum_j ||H[,j]||_1^2)) s.t. W>=0, H>=0 } The algorithm \sQuote{SNMF/L} solves a similar problem on the transposed target matrix \eqn{A}, where \eqn{H} and \eqn{W} swap roles, i.e. with sparsity constraints applied to \code{W}. } \references{ Kim H and Park H (2007). "Sparse non-negative matrix factorizations via alternating non-negativity-constrained least squares for microarray data analysis." _Bioinformatics (Oxford, England)_, *23*(12), pp. 1495-502. ISSN 1460-2059, , . } NMF/man/cluster_mat.Rd0000644000176000001440000000154212234465004014310 0ustar ripleyusers\name{cluster_mat} \alias{cluster_mat} \title{Cluster Matrix Rows in Annotated Heatmaps} \usage{ cluster_mat(mat, param, distfun, hclustfun, reorderfun, na.rm = TRUE, subset = NULL, verbose = FALSE) } \arguments{ \item{mat}{original input matrix that has already been appropriately subset in the caller function (\code{aheatmap})} \item{param}{clustering specifications} \item{distfun}{Default distance method/function} \item{hclustfun}{Default clustering (linkage) method/function} \item{reorderfun}{Default reordering function} \item{na.rm}{Logical that specifies if NA values should be removed} \item{subset}{index (integer) vector specifying the subset indexes used to subset mat. This is required to be able to return the original indexes.} } \description{ Cluster Matrix Rows in Annotated Heatmaps } \keyword{internal} NMF/man/NMFStrategy-class.Rd0000644000176000001440000001034512234470405015236 0ustar ripleyusers\docType{class} \name{NMFStrategy-class} \alias{is.mixed} \alias{NMFStrategy-class} \alias{objective<-,NMFStrategy,character-method} \alias{objective<-,NMFStrategy,function-method} \alias{objective,NMFStrategy-method} \alias{show,NMFStrategy-method} \title{Virtual Interface for NMF Algorithms} \usage{ \S4method{show}{NMFStrategy}(object) \S4method{objective}{NMFStrategy}(object) \S4method{objective}{NMFStrategy,character}(object)<-value \S4method{objective}{NMFStrategy,function}(object)<-value is.mixed(object) } \arguments{ \item{object}{Any R object} \item{value}{replacement value} } \description{ This class partially implements the generic interface defined for general algorithms defined in the \pkg{NMF} package (see \code{\link{algorithmic-NMF}}). \code{is.mixed} tells if an NMF algorithm works on mixed-sign data. } \section{Slots}{ \describe{ \item{objective}{the objective function associated with the algorithm (Frobenius, Kullback-Leibler, etc...). It is either an access key of a registered objective function or a function definition. In the latter case, the given function must have the following signature \code{(x="NMF", y="matrix")} and return a nonnegative real value.} \item{model}{a character string giving either the (sub)class name of the NMF-class instance used and returned by the strategy, or a function name.} \item{mixed}{a logical that indicates if the algorithm works on mixed-sign data.} } } \section{Methods}{ \describe{ \item{canFit}{\code{signature(x = "NMFStrategy", y = "character")}: Tells if an NMF algorithm can fit a given class of NMF models } \item{canFit}{\code{signature(x = "NMFStrategy", y = "NMF")}: Tells if an NMF algorithm can fit the same class of models as \code{y} } \item{deviance}{\code{signature(object = "NMFStrategy")}: Computes the value of the objective function between the estimate \code{x} and the target \code{y}. } \item{modelname}{\code{signature(object = "NMFStrategy")}: Returns the model(s) that an NMF algorithm can fit. } \item{NMFStrategy}{\code{signature(name = "NMFStrategy", method = "missing")}: Creates an \code{NMFStrategy} based on a template object (Constructor-Copy), in particular it uses the \strong{same} name. } \item{objective}{\code{signature(object = "NMFStrategy")}: Gets the objective function associated with an NMF algorithm. It is used in \code{\link[=deviance,NMFStrategy-method]{deviance}} to compute the objective value for an NMF model with respect to a given target matrix. } \item{objective}{\code{signature(object = "NMFStrategy")}: Gets the objective function associated with an NMF algorithm. It is used in \code{\link[=deviance,NMFStrategy-method]{deviance}} to compute the objective value for an NMF model with respect to a given target matrix. } \item{objective<-}{\code{signature(object = "NMFStrategy", value = "character")}: Sets the objective function associated with an NMF algorithm, with a character string that must be a registered objective function. } \item{objective<-}{\code{signature(object = "NMFStrategy", value = "character")}: Sets the objective function associated with an NMF algorithm, with a character string that must be a registered objective function. } \item{objective<-}{\code{signature(object = "NMFStrategy", value = "function")}: Sets the objective function associated with an NMF algorithm, with a function that computes the approximation error between an NMF model and a target matrix. } \item{objective<-}{\code{signature(object = "NMFStrategy", value = "function")}: Sets the objective function associated with an NMF algorithm, with a function that computes the approximation error between an NMF model and a target matrix. } \item{run}{\code{signature(object = "NMFStrategy", y = "matrix", x = "NMFfit")}: Pure virtual method defined for all NMF algorithms to ensure that a method \code{run} is defined by sub-classes of \code{NMFStrategy}. It throws an error if called directly. } \item{run}{\code{signature(object = "NMFStrategy", y = "matrix", x = "NMF")}: Method to run an NMF algorithm directly starting from a given NMF model. } } } \keyword{internal} \keyword{methods} NMF/man/sparseness.Rd0000644000176000001440000000465112234465004014160 0ustar ripleyusers\docType{methods} \name{sparseness} \alias{sparseness} \alias{sparseness,matrix-method} \alias{sparseness-methods} \alias{sparseness,NMF-method} \alias{sparseness,numeric-method} \title{Sparseness} \usage{ sparseness(x, ...) } \arguments{ \item{x}{an object whose sparseness is computed.} \item{...}{extra arguments to allow extension} } \value{ usually a single numeric value -- in [0,1], or a numeric vector. See each method for more details. } \description{ Generic function that computes the \emph{sparseness} of an object, as defined by \cite{Hoyer (2004)}. The sparseness quantifies how much energy of a vector is packed into only few components. } \details{ In \cite{Hoyer (2004)}, the sparseness is defined for a real vector \eqn{x} as: \deqn{Sparseness(x) = \frac{\sqrt{n} - \frac{\sum |x_i|}{\sqrt{\sum x_i^2}}}{\sqrt{n}-1}}{ (srqt(n) - ||x||_1 / ||x||_2) / (sqrt(n) - 1)} , where \eqn{n} is the length of \eqn{x}. The sparseness is a real number in \eqn{[0,1]}. It is equal to 1 if and only if \code{x} contains a single nonzero component, and is equal to 0 if and only if all components of \code{x} are equal. It interpolates smoothly between these two extreme values. The closer to 1 is the sparseness the sparser is the vector. The basic definition is for a \code{numeric} vector, and is extended for matrices as the mean sparseness of its column vectors. } \section{Methods}{ \describe{ \item{sparseness}{\code{signature(x = "numeric")}: Base method that computes the sparseness of a numeric vector. It returns a single numeric value, computed following the definition given in section \emph{Description}. } \item{sparseness}{\code{signature(x = "matrix")}: Computes the sparseness of a matrix as the mean sparseness of its column vectors. It returns a single numeric value. } \item{sparseness}{\code{signature(x = "NMF")}: Compute the sparseness of an object of class \code{NMF}, as the sparseness of the basis and coefficient matrices computed separately. It returns the two values in a numeric vector with names \sQuote{basis} and \sQuote{coef}. } } } \references{ Hoyer P (2004). "Non-negative matrix factorization with sparseness constraints." _The Journal of Machine Learning Research_, *5*, pp. 1457-1469. . } \seealso{ Other assess: \code{\link{entropy}}, \code{\link{purity}} } \keyword{methods} NMF/man/KL-nmf.Rd0000644000176000001440000001430512305630424013052 0ustar ripleyusers\name{nmf_update.brunet_R} \alias{brunet_M-nmf} \alias{brunet-nmf} \alias{brunet_R-nmf} \alias{KL-nmf} \alias{nmfAlgorithm.brunet} \alias{nmfAlgorithm.brunet_M} \alias{nmfAlgorithm.brunet_R} \alias{nmfAlgorithm.KL} \alias{nmf_update.brunet} \alias{nmf_update.brunet_R} \title{NMF Algorithm/Updates for Kullback-Leibler Divergence} \source{ Original MATLAB files and references can be found at: \url{http://www.broadinstitute.org/mpr/publications/projects/NMF/nmf.m} \url{http://www.broadinstitute.org/publications/broad872} Original license terms: This software and its documentation are copyright 2004 by the Broad Institute/Massachusetts Institute of Technology. All rights are reserved. This software is supplied without any warranty or guaranteed support whatsoever. Neither the Broad Institute nor MIT can not be responsible for its use, misuse, or functionality. } \usage{ nmf_update.brunet_R(i, v, x, eps = .Machine$double.eps, ...) nmf_update.brunet(i, v, x, copy = FALSE, eps = .Machine$double.eps, ...) nmfAlgorithm.brunet_R(..., .stop = NULL, maxIter = nmf.getOption("maxIter") \%||\% 2000, eps = .Machine$double.eps, stopconv = 40, check.interval = 10) nmfAlgorithm.brunet(..., .stop = NULL, maxIter = nmf.getOption("maxIter") \%||\% 2000, copy = FALSE, eps = .Machine$double.eps, stopconv = 40, check.interval = 10) nmfAlgorithm.KL(..., .stop = NULL, maxIter = nmf.getOption("maxIter") \%||\% 2000, copy = FALSE, eps = .Machine$double.eps, stationary.th = .Machine$double.eps, check.interval = 5 * check.niter, check.niter = 10L) nmfAlgorithm.brunet_M(..., object, y, x) } \arguments{ \item{i}{current iteration number.} \item{v}{target matrix.} \item{x}{current NMF model, as an \code{\linkS4class{NMF}} object.} \item{eps}{small numeric value used to ensure numeric stability, by shifting up entries from zero to this fixed value.} \item{...}{extra arguments. These are generally not used and present only to allow other arguments from the main call to be passed to the initialisation and stopping criterion functions (slots \code{onInit} and \code{Stop} respectively).} \item{copy}{logical that indicates if the update should be made on the original matrix directly (\code{FALSE}) or on a copy (\code{TRUE} - default). With \code{copy=FALSE} the memory footprint is very small, and some speed-up may be achieved in the case of big matrices. However, greater care should be taken due the side effect. We recommend that only experienced users use \code{copy=TRUE}.} \item{.stop}{specification of a stopping criterion, that is used instead of the one associated to the NMF algorithm. It may be specified as: \itemize{ \item the access key of a registered stopping criterion; \item a single integer that specifies the exact number of iterations to perform, which will be honoured unless a lower value is explicitly passed in argument \code{maxIter}. \item a single numeric value that specifies the stationnarity threshold for the objective function, used in with \code{\link{nmf.stop.stationary}}; \item a function with signature \code{(object="NMFStrategy", i="integer", y="matrix", x="NMF", ...)}, where \code{object} is the \code{NMFStrategy} object that describes the algorithm being run, \code{i} is the current iteration, \code{y} is the target matrix and \code{x} is the current value of the NMF model. }} \item{maxIter}{maximum number of iterations to perform.} \item{object}{an object computed using some algorithm, or that describes an algorithm itself.} \item{y}{data object, e.g. a target matrix} \item{stopconv}{number of iterations intervals over which the connectivity matrix must not change for stationarity to be achieved.} \item{check.interval}{interval (in number of iterations) on which the stopping criterion is computed.} \item{stationary.th}{maximum absolute value of the gradient, for the objective function to be considered stationary.} \item{check.niter}{number of successive iteration used to compute the stationnary criterion.} } \description{ The built-in NMF algorithms described here minimise the Kullback-Leibler divergence (KL) between an NMF model and a target matrix. They use the updates for the basis and coefficient matrices (\eqn{W} and \eqn{H}) defined by \cite{Brunet et al. (2004)}, which are essentially those from \cite{Lee et al. (2001)}, with an stabilisation step that shift up all entries from zero every 10 iterations, to a very small positive value. \code{nmf_update.brunet} implements in C++ an optimised version of the single update step. Algorithms \sQuote{brunet} and \sQuote{.R#brunet} provide the complete NMF algorithm from \cite{Brunet et al. (2004)}, using the C++-optimised and pure R updates \code{\link{nmf_update.brunet}} and \code{\link{nmf_update.brunet_R}} respectively. Algorithm \sQuote{KL} provides an NMF algorithm based on the C++-optimised version of the updates from \cite{Brunet et al. (2004)}, which uses the stationarity of the objective value as a stopping criterion \code{\link{nmf.stop.stationary}}, instead of the stationarity of the connectivity matrix \code{\link{nmf.stop.connectivity}} as used by \sQuote{brunet}. \samp{ library(RcppOctave) file.show(system.mfile('brunet.m', package='NMF')) } } \details{ \code{nmf_update.brunet_R} implements in pure R a single update step, i.e. it updates both matrices. } \author{ Original implementation in MATLAB: Jean-Philippe Brunet \email{brunet@broad.mit.edu} Port to R and optimisation in C++: Renaud Gaujoux } \references{ Brunet J, Tamayo P, Golub TR and Mesirov JP (2004). "Metagenes and molecular pattern discovery using matrix factorization." _Proceedings of the National Academy of Sciences of the United States of America_, *101*(12), pp. 4164-9. ISSN 0027-8424, , . Lee DD and Seung H (2001). "Algorithms for non-negative matrix factorization." _Advances in neural information processing systems_. . } NMF/man/c-commaNMF-method.Rd0000644000176000001440000000161612234465004015123 0ustar ripleyusers\docType{methods} \name{c,NMF-method} \alias{c,NMF-method} \title{Concatenating NMF Models} \usage{ \S4method{c}{NMF}(x, ..., margin = 3, recursive = FALSE) } \arguments{ \item{x}{an NMF model} \item{...}{other objects to concatenate. Currently only two objects at a time can be concatenated (i.e. \code{x} and \code{..1}).} \item{margin}{integer that indicates the margin along which to concatenate (only used when \code{..1} is a matrix): \describe{ \item{1L}{} \item{2L}{} \item{3L}{} \item{4L}{} } If missing the margin is heuristically determined by looking at common dimensions between the objects.} \item{recursive}{logical. If \code{recursive = TRUE}, the function recursively descends through lists (and pairlists) combining all their elements into a vector.} } \description{ Binds compatible matrices and NMF models together. } \keyword{internal} \keyword{methods} NMF/man/basis-coef-methods.Rd0000644000176000001440000002513112305630424015441 0ustar ripleyusers\docType{methods} \name{basis} \alias{basis} \alias{.basis} \alias{.basis<-} \alias{basis<-} \alias{basis,ANY-method} \alias{.basis<--methods} \alias{.basis-methods} \alias{basis<--methods} \alias{basis-methods} \alias{.basis<-,NMFfit,matrix-method} \alias{.basis,NMFfit-method} \alias{basis,NMFfitXn-method} \alias{.basis<-,NMF,matrix-method} \alias{.basis,NMF-method} \alias{basis<-,NMF-method} \alias{basis,NMF-method} \alias{.basis<-,NMFstd,matrix-method} \alias{.basis,NMFstd-method} \alias{coef} \alias{.coef} \alias{.coef<-} \alias{coef<-} \alias{coefficients} \alias{coefficients-methods} \alias{coefficients,NMF-method} \alias{.coef<--methods} \alias{.coef-methods} \alias{coef<--methods} \alias{coef-methods} \alias{.coef<-,NMFfit,matrix-method} \alias{.coef,NMFfit-method} \alias{coef,NMFfitXn-method} \alias{.coef<-,NMF,matrix-method} \alias{.coef,NMF-method} \alias{coef<-,NMF-method} \alias{coef,NMF-method} \alias{.coef<-,NMFstd,matrix-method} \alias{.coef,NMFstd-method} \alias{loadings,NMF-method} \alias{scoef} \alias{scoef,matrix-method} \alias{scoef-methods} \alias{scoef,NMF-method} \title{Accessing NMF Factors} \usage{ basis(object, ...) \S4method{basis}{NMF}(object, all = TRUE, ...) .basis(object, ...) basis(object, ...)<-value \S4method{basis}{NMF}(object, use.dimnames = TRUE, ...)<-value .basis(object)<-value \S4method{loadings}{NMF}(x) coef(object, ...) \S4method{coef}{NMF}(object, all = TRUE, ...) .coef(object, ...) coef(object, ...)<-value \S4method{coef}{NMF}(object, use.dimnames = TRUE, ...)<-value .coef(object)<-value coefficients(object, ...) \S4method{coefficients}{NMF}(object, all = TRUE, ...) scoef(object, ...) \S4method{scoef}{NMF}(object, scale = 1) \S4method{scoef}{matrix}(object, scale = 1) } \arguments{ \item{object}{an object from which to extract the factor matrices, typically an object of class \code{\linkS4class{NMF}}.} \item{...}{extra arguments to allow extension and passed to the low-level access functions \code{.coef} and \code{.basis}. Note that these throw an error if used in replacement functions \code{}.} \item{all}{a logical that indicates whether the complete matrix factor should be returned (\code{TRUE}) or only the non-fixed part. This is relevant only for formula-based NMF models that include fixed basis or coefficient terms.} \item{use.dimnames}{logical that indicates if the object's dim names should be set using those from the new value, or left unchanged -- after truncating them to fit new dimensions if necessary. This is useful to only set the entries of a factor.} \item{value}{replacement value} \item{scale}{scaling factor, which indicates to the value the columns of the coefficient matrix should sum up to.} \item{x}{an object of class \code{"\link{factanal}"} or \code{"\link{princomp}"} or the \code{loadings} component of such an object.} } \description{ \code{basis} and \code{basis<-} are S4 generic functions which respectively extract and set the matrix of basis components of an NMF model (i.e. the first matrix factor). The methods \code{.basis}, \code{.coef} and their replacement versions are implemented as pure virtual methods for the interface class \code{NMF}, meaning that concrete NMF models must provide a definition for their corresponding class (i.e. sub-classes of class \code{NMF}). See \code{\linkS4class{NMF}} for more details. \code{coef} and \code{coef<-} respectively extract and set the coefficient matrix of an NMF model (i.e. the second matrix factor). For example, in the case of the standard NMF model \eqn{V \equiv WH}{V ~ W H}, the method \code{coef} will return the matrix \eqn{H}. \code{.coef} and \code{.coef<-} are low-level S4 generics that simply return/set coefficient data in an object, leaving some common processing to be performed in \code{coef} and \code{coef<-}. Methods \code{coefficients} and \code{coefficients<-} are simple aliases for methods \code{coef} and \code{coef<-} respectively. \code{scoef} is similar to \code{coef}, but returns the mixture coefficient matrix of an NMF model, with the columns scaled so that they sum up to a given value (1 by default). } \details{ For example, in the case of the standard NMF model \eqn{V \equiv W H}{V ~ W H}, the method \code{basis} will return the matrix \eqn{W}. \code{basis} and \code{basis<-} are defined for the top virtual class \code{\linkS4class{NMF}} only, and rely internally on the low-level S4 generics \code{.basis} and \code{.basis<-} respectively that effectively extract/set the coefficient data. These data are post/pre-processed, e.g., to extract/set only their non-fixed terms or check dimension compatibility. \code{coef} and \code{coef<-} are S4 methods defined for the corresponding generic functions from package \code{stats} (See \link[stats]{coef}). Similarly to \code{basis} and \code{basis<-}, they are defined for the top virtual class \code{\linkS4class{NMF}} only, and rely internally on the S4 generics \code{.coef} and \code{.coef<-} respectively that effectively extract/set the coefficient data. These data are post/pre-processed, e.g., to extract/set only their non-fixed terms or check dimension compatibility. } \section{Methods}{ \describe{ \item{basis}{\code{signature(object = "ANY")}: Default method returns the value of S3 slot or attribute \code{'basis'}. It returns \code{NULL} if none of these are set. Arguments \code{...} are not used by this method. } \item{basis}{\code{signature(object = "NMFfitXn")}: Returns the basis matrix of the best fit amongst all the fits stored in \code{object}. It is a shortcut for \code{basis(fit(object))}. } \item{.basis}{\code{signature(object = "NMF")}: Pure virtual method for objects of class \code{\linkS4class{NMF}}, that should be overloaded by sub-classes, and throws an error if called. } \item{.basis}{\code{signature(object = "NMFstd")}: Get the basis matrix in standard NMF models This function returns slot \code{W} of \code{object}. } \item{.basis}{\code{signature(object = "NMFfit")}: Returns the basis matrix from an NMF model fitted with function \code{\link{nmf}}. It is a shortcut for \code{.basis(fit(object), ...)}, dispatching the call to the \code{.basis} method of the actual NMF model. } \item{.basis<-}{\code{signature(object = "NMF", value = "matrix")}: Pure virtual method for objects of class \code{\linkS4class{NMF}}, that should be overloaded by sub-classes, and throws an error if called. } \item{.basis<-}{\code{signature(object = "NMFstd", value = "matrix")}: Set the basis matrix in standard NMF models This function sets slot \code{W} of \code{object}. } \item{.basis<-}{\code{signature(object = "NMFfit", value = "matrix")}: Sets the the basis matrix of an NMF model fitted with function \code{\link{nmf}}. It is a shortcut for \code{.basis(fit(object)) <- value}, dispatching the call to the \code{.basis<-} method of the actual NMF model. It is not meant to be used by the user, except when developing NMF algorithms, to update the basis matrix of the seed object before returning it. } \item{basis<-}{\code{signature(object = "NMF")}: Default methods that calls \code{.basis<-} and check the validity of the updated object. } \item{coef}{\code{signature(object = "NMFfitXn")}: Returns the coefficient matrix of the best fit amongst all the fits stored in \code{object}. It is a shortcut for \code{coef(fit(object))}. } \item{.coef}{\code{signature(object = "NMF")}: Pure virtual method for objects of class \code{\linkS4class{NMF}}, that should be overloaded by sub-classes, and throws an error if called. } \item{.coef}{\code{signature(object = "NMFstd")}: Get the mixture coefficient matrix in standard NMF models This function returns slot \code{H} of \code{object}. } \item{.coef}{\code{signature(object = "NMFfit")}: Returns the the coefficient matrix from an NMF model fitted with function \code{\link{nmf}}. It is a shortcut for \code{.coef(fit(object), ...)}, dispatching the call to the \code{.coef} method of the actual NMF model. } \item{.coef<-}{\code{signature(object = "NMF", value = "matrix")}: Pure virtual method for objects of class \code{\linkS4class{NMF}}, that should be overloaded by sub-classes, and throws an error if called. } \item{.coef<-}{\code{signature(object = "NMFstd", value = "matrix")}: Set the mixture coefficient matrix in standard NMF models This function sets slot \code{H} of \code{object}. } \item{.coef<-}{\code{signature(object = "NMFfit", value = "matrix")}: Sets the the coefficient matrix of an NMF model fitted with function \code{\link{nmf}}. It is a shortcut for \code{.coef(fit(object)) <- value}, dispatching the call to the \code{.coef<-} method of the actual NMF model. It is not meant to be used by the user, except when developing NMF algorithms, to update the coefficient matrix in the seed object before returning it. } \item{coef<-}{\code{signature(object = "NMF")}: Default methods that calls \code{.coef<-} and check the validity of the updated object. } \item{coefficients}{\code{signature(object = "NMF")}: Alias to \code{coef,NMF}, therefore also pure virtual. } \item{loadings}{\code{signature(x = "NMF")}: Method loadings for NMF Models The method \code{loadings} is identical to \code{basis}, but do not accept any extra argument. The method \code{loadings} is provided to standardise the NMF interface against the one defined in the \code{\link{stats}} package, and emphasises the similarities between NMF and PCA or factorial analysis (see \code{\link{loadings}}). } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } #---------- # scoef #---------- # Scaled coefficient matrix x <- rnmf(3, 10, 5) scoef(x) scoef(x, 100) #---------- # .basis,NMFstd-method #---------- # random standard NMF model x <- rnmf(3, 10, 5) basis(x) coef(x) # set matrix factors basis(x) <- matrix(1, nrow(x), nbasis(x)) coef(x) <- matrix(1, nbasis(x), ncol(x)) # set random factors basis(x) <- rmatrix(basis(x)) coef(x) <- rmatrix(coef(x)) # incompatible matrices generate an error: try( coef(x) <- matrix(1, nbasis(x)-1, nrow(x)) ) # but the low-level method allow it .coef(x) <- matrix(1, nbasis(x)-1, nrow(x)) try( validObject(x) ) } \seealso{ Other NMF-interface: \code{\link{.DollarNames,NMF-method}}, \code{\link{misc}}, \code{\link{NMF-class}}, \code{\link{$<-,NMF-method}}, \code{\link{$,NMF-method}}, \code{\link{nmfModel}}, \code{\link{nmfModels}}, \code{\link{rnmf}} } \keyword{methods} NMF/man/NMFns-class.Rd0000644000176000001440000001062212305630424014050 0ustar ripleyusers\docType{class} \name{NMFns-class} \alias{NMFns-class} \title{NMF Model - Nonsmooth Nonnegative Matrix Factorization} \description{ This class implements the \emph{Nonsmooth Nonnegative Matrix Factorization} (nsNMF) model, required by the Nonsmooth NMF algorithm. The Nonsmooth NMF algorithm is defined by \cite{Pascual-Montano et al. (2006)} as a modification of the standard divergence based NMF algorithm (see section Details and references below). It aims at obtaining sparser factor matrices, by the introduction of a smoothing matrix. } \details{ The Nonsmooth NMF algorithm is a modification of the standard divergence based NMF algorithm (see \code{\linkS4class{NMF}}). Given a non-negative \eqn{n \times p}{n x p} matrix \eqn{V} and a factorization rank \eqn{r}, it fits the following model: \deqn{V \equiv W S(\theta) H,}{V ~ W S(theta) H,} where: \itemize{ \item \eqn{W} and \eqn{H} are such as in the standard model, i.e. non-negative matrices of dimension \eqn{n \times r}{n x r} and \eqn{r \times p}{r x p} respectively; \item \eqn{S} is a \eqn{r \times r} square matrix whose entries depends on an extra parameter \eqn{0\leq \theta \leq 1} in the following way: \deqn{S = (1-\theta)I + \frac{\theta}{r} 11^T ,} where \eqn{I} is the identity matrix and \eqn{1} is a vector of ones. } The interpretation of S as a smoothing matrix can be explained as follows: Let \eqn{X} be a positive, nonzero, vector. Consider the transformed vector \eqn{Y = S X}. If \eqn{\theta = 0}, then \eqn{Y = X} and no smoothing on \eqn{X} has occurred. However, as \eqn{\theta \to 1}{theta tends to 1}, the vector \eqn{Y} tends to the constant vector with all elements almost equal to the average of the elements of \eqn{X}. This is the smoothest possible vector in the sense of non-sparseness because all entries are equal to the same nonzero value, instead of having some values close to zero and others clearly nonzero. } \section{Methods}{ \describe{ \item{fitted}{\code{signature(object = "NMFns")}: Compute estimate for an NMFns object, according to the Nonsmooth NMF model (cf. \code{\link{NMFns-class}}). Extra arguments in \code{...} are passed to method \code{smoothing}, and are typically used to pass a value for \code{theta}, which is used to compute the smoothing matrix instead of the one stored in \code{object}. } \item{show}{\code{signature(object = "NMFns")}: Show method for objects of class \code{NMFns} } } } \section{Creating objects from the Class}{ Object of class \code{NMFns} can be created using the standard way with operator \code{\link{new}} However, as for all NMF model classes -- that extend class \code{\linkS4class{NMF}}, objects of class \code{NMFns} should be created using factory method \code{\link{nmfModel}} : \code{new('NMFns')} \code{nmfModel(model='NMFns')} \code{nmfModel(model='NMFns', W=w, theta=0.3} See \code{\link{nmfModel}} for more details on how to use the factory method. } \section{Algorithm}{ The Nonsmooth NMF algorithm uses a modified version of the multiplicative update equations in Lee & Seung's method for Kullback-Leibler divergence minimization. The update equations are modified to take into account the -- constant -- smoothing matrix. The modification reduces to using matrix \eqn{W S} instead of matrix \eqn{W} in the update of matrix \eqn{H}, and similarly using matrix \eqn{S H} instead of matrix \eqn{H} in the update of matrix \eqn{W}. After the matrix \eqn{W} has been updated, each of its columns is scaled so that it sums up to 1. } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # create a completely empty NMFns object new('NMFns') # create a NMF object based on random (compatible) matrices n <- 50; r <- 3; p <- 20 w <- rmatrix(n, r) h <- rmatrix(r, p) nmfModel(model='NMFns', W=w, H=h) # apply Nonsmooth NMF algorithm to a random target matrix V <- rmatrix(n, p) \dontrun{nmf(V, r, 'ns')} # random nonsmooth NMF model rnmf(3, 10, 5, model='NMFns', theta=0.3) } \references{ Pascual-Montano A, Carazo JM, Kochi K, Lehmann D and Pascual-marqui RD (2006). "Nonsmooth nonnegative matrix factorization (nsNMF)." _IEEE Trans. Pattern Anal. Mach. Intell_, *28*, pp. 403-415. } \seealso{ Other NMF-model: \code{\link{initialize,NMFOffset-method}}, \code{\link{NMFOffset-class}}, \code{\link{NMFstd-class}} } NMF/man/NMF-deprecated.Rd0000644000176000001440000000034212234465004014501 0ustar ripleyusers\name{NMF-deprecated} \alias{NMF-deprecated} \title{Deprecated Functions in the Package NMF} \arguments{ \item{object}{an R object} \item{...}{extra arguments} } \description{ Deprecated Functions in the Package NMF } NMF/man/consensus-commaNMFfitXn-method.Rd0000644000176000001440000000173112234465004017730 0ustar ripleyusers\docType{methods} \name{consensus,NMFfitXn-method} \alias{consensus,NMFfitXn-method} \alias{plot.NMF.consensus} \title{Computes the consensus matrix of the set of fits stored in \code{object}, as the mean connectivity matrix across runs.} \usage{ \S4method{consensus}{NMFfitXn}(object, ..., no.attrib = FALSE) } \arguments{ \item{object}{an object with a suitable \code{\link{predict}} method.} \item{...}{extra arguments to allow extension. They are passed to \code{\link{predict}}, except for the \code{vector} and \code{factor} methods.} \item{no.attrib}{a logical that indicates if attributes containing information about the NMF model should be attached to the result (\code{TRUE}) or not (\code{FALSE}).} } \description{ This method returns \code{NULL} on an empty object. The result is a matrix with several attributes attached, that are used by plotting functions such as \code{\link{consensusmap}} to annotate the plots. } \keyword{methods} NMF/man/nmfFormals.Rd0000644000176000001440000000122712305630424014071 0ustar ripleyusers\name{nmfFormals} \alias{nmfArgs} \alias{nmfFormals} \title{Showing Arguments of NMF Algorithms} \usage{ nmfFormals(x, ...) nmfArgs(x) } \arguments{ \item{x}{algorithm specification} \item{...}{extra argument to allow extension} } \description{ This function returns the extra arguments that can be passed to a given NMF algorithm in call to \code{\link{nmf}}. \code{nmfArgs} is a shortcut for \code{args(nmfWrapper(x))}, to display the arguments of a given NMF algorithm. } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # show arguments of an NMF algorithm nmfArgs('brunet') nmfArgs('snmf/r') } NMF/man/lverbose.Rd0000644000176000001440000000040212234465004013601 0ustar ripleyusers\name{lverbose} \alias{lverbose} \title{Internal verbosity option} \usage{ lverbose(val) } \arguments{ \item{val}{logical that sets the verbosity level.} } \value{ the old verbose level } \description{ Internal verbosity option } \keyword{internal} NMF/man/fcnnls.Rd0000644000176000001440000001252512305630424013253 0ustar ripleyusers\docType{methods} \name{fcnnls} \alias{fcnnls} \alias{fcnnls,ANY,numeric-method} \alias{fcnnls,matrix,matrix-method} \alias{fcnnls-methods} \alias{fcnnls,numeric,matrix-method} \title{Fast Combinatorial Nonnegative Least-Square} \usage{ fcnnls(x, y, ...) \S4method{fcnnls}{matrix,matrix}(x, y, verbose = FALSE, pseudo = TRUE, ...) } \arguments{ \item{...}{extra arguments passed to the internal function \code{.fcnnls}. Currently not used.} \item{verbose}{toggle verbosity (default is \code{FALSE}).} \item{x}{the coefficient matrix} \item{y}{the target matrix to be approximated by \eqn{X K}.} \item{pseudo}{By default (\code{pseudo=FALSE}) the algorithm uses Gaussian elimination to solve the successive internal linear problems, using the \code{\link{solve}} function. If \code{pseudo=TRUE} the algorithm uses Moore-Penrose generalized \code{\link[corpcor]{pseudoinverse}} from the \code{corpcor} package instead of \link{solve}.} } \value{ A list containing the following components: \item{x}{ the estimated optimal matrix \eqn{K}.} \item{fitted}{ the fitted matrix \eqn{X K}.} \item{residuals}{ the residual matrix \eqn{Y - X K}.} \item{deviance}{ the residual sum of squares between the fitted matrix \eqn{X K} and the target matrix \eqn{Y}. That is the sum of the square residuals.} \item{passive}{ a \eqn{r x p} logical matrix containing the passive set, that is the set of entries in \eqn{K} that are not null (i.e. strictly positive).} \item{pseudo}{ a logical that is \code{TRUE} if the computation was performed using the pseudoinverse. See argument \code{pseudo}.} } \description{ This function solves the following nonnegative least square linear problem using normal equations and the fast combinatorial strategy from \cite{Van Benthem et al. (2004)}: \deqn{ \begin{array}{l} \min \|Y - X K\|_F\\ \mbox{s.t. } K>=0 \end{array} }{min ||Y - X K||_F, s.t. K>=0} where \eqn{Y} and \eqn{X} are two real matrices of dimension \eqn{n \times p}{n x p} and \eqn{n \times r}{n x r} respectively, and \eqn{\|.\|_F}{|.|_F} is the Frobenius norm. The algorithm is very fast compared to other approaches, as it is optimised for handling multiple right-hand sides. } \details{ Within the \code{NMF} package, this algorithm is used internally by the SNMF/R(L) algorithm from \cite{Kim et al. (2007)} to solve general Nonnegative Matrix Factorization (NMF) problems, using alternating nonnegative constrained least-squares. That is by iteratively and alternatively estimate each matrix factor. The algorithm is an active/passive set method, which rearrange the right-hand side to reduce the number of pseudo-inverse calculations. It uses the unconstrained solution \eqn{K_u} obtained from the unconstrained least squares problem, i.e. \eqn{\min \|Y - X K\|_F^2}{min ||Y - X K||_F^2} , so as to determine the initial passive sets. The function \code{fcnnls} is provided separately so that it can be used to solve other types of nonnegative least squares problem. For faster computation, when multiple nonnegative least square fits are needed, it is recommended to directly use the function \code{\link{.fcnnls}}. The code of this function is a port from the original MATLAB code provided by \cite{Kim et al. (2007)}. } \section{Methods}{ \describe{ \item{fcnnls}{\code{signature(x = "matrix", y = "matrix")}: This method wraps a call to the internal function \code{.fcnnls}, and formats the results in a similar way as other lest-squares methods such as \code{\link{lm}}. } \item{fcnnls}{\code{signature(x = "numeric", y = "matrix")}: Shortcut for \code{fcnnls(as.matrix(x), y, ...)}. } \item{fcnnls}{\code{signature(x = "ANY", y = "numeric")}: Shortcut for \code{fcnnls(x, as.matrix(y), ...)}. } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } ## Define a random nonnegative matrix matrix n <- 200; p <- 20; r <- 3 V <- rmatrix(n, p) ## Compute the optimal matrix K for a given X matrix X <- rmatrix(n, r) res <- fcnnls(X, V) ## Compute the same thing using the Moore-Penrose generalized pseudoinverse res <- fcnnls(X, V, pseudo=TRUE) ## It also works in the case of single vectors y <- runif(n) res <- fcnnls(X, y) # or res <- fcnnls(X[,1], y) } \author{ Original MATLAB code : Van Benthem and Keenan Adaption of MATLAB code for SNMF/R(L): H. Kim Adaptation to the NMF package framework: Renaud Gaujoux } \references{ Original MATLAB code from Van Benthem and Keenan, slightly modified by H. Kim:\cr \url{http://www.cc.gatech.edu/~hpark/software/fcnnls.m} Van Benthem M and Keenan MR (2004). "Fast algorithm for the solution of large-scale non-negativity-constrained least squares problems." _Journal of Chemometrics_, *18*(10), pp. 441-450. ISSN 0886-9383, , . Kim H and Park H (2007). "Sparse non-negative matrix factorizations via alternating non-negativity-constrained least squares for microarray data analysis." _Bioinformatics (Oxford, England)_, *23*(12), pp. 1495-502. ISSN 1460-2059, , . } \seealso{ \code{\link{nmf}} } \keyword{methods} \keyword{multivariate} \keyword{optimize} \keyword{regression} NMF/man/NMFStrategyFunction-class.Rd0000644000176000001440000000334012234465004016740 0ustar ripleyusers\docType{class} \name{NMFStrategyFunction-class} \alias{NMFStrategyFunction-class} \title{Interface for Single Function NMF Strategies} \description{ This class implements the virtual interface \code{\link{NMFStrategy}} for NMF algorithms that are implemented by a single workhorse R function. } \section{Slots}{ \describe{ \item{algorithm}{a function that implements an NMF algorithm. It must have signature \code{(y='matrix', x='NMFfit')}, where \code{y} is the target matrix to approximate and \code{x} is the NMF model assumed to be seeded with an appropriate initial value -- as it is done internally by function \code{\link{nmf}}. Note that argument names currently do not matter, but it is recommended to name them as specified above.} } } \section{Methods}{ \describe{ \item{algorithm}{\code{signature(object = "NMFStrategyFunction")}: Returns the single R function that implements the NMF algorithm -- as stored in slot \code{algorithm}. } \item{algorithm<-}{\code{signature(object = "NMFStrategyFunction", value = "function")}: Sets the function that implements the NMF algorithm, stored in slot \code{algorithm}. } \item{run}{\code{signature(object = "NMFStrategyFunction", y = "matrix", x = "NMFfit")}: Runs the NMF algorithms implemented by the single R function -- and stored in slot \code{'algorithm'} of \code{object}, on the data object \code{y}, using \code{x} as starting point. It is equivalent to calling \code{object@algorithm(y, x, ...)}. This method is usually not called directly, but only via the function \code{\link{nmf}}, which takes care of many other details such as seeding the computation, handling RNG settings, or setting up parallelisation. } } } NMF/man/purity.Rd0000644000176000001440000001274212305630424013325 0ustar ripleyusers\docType{methods} \name{purity} \alias{entropy} \alias{entropy,ANY,ANY-method} \alias{entropy,factor,ANY-method} \alias{entropy-methods} \alias{entropy,NMFfitXn,ANY-method} \alias{entropy,table,missing-method} \alias{purity} \alias{purity,ANY,ANY-method} \alias{purity,factor,ANY-method} \alias{purity-methods} \alias{purity,NMFfitXn,ANY-method} \alias{purity,table,missing-method} \title{Purity and Entropy of a Clustering} \usage{ purity(x, y, ...) entropy(x, y, ...) \S4method{purity}{NMFfitXn,ANY}(x, y, method = "best", ...) \S4method{entropy}{NMFfitXn,ANY}(x, y, method = "best", ...) } \arguments{ \item{x}{an object that can be interpreted as a factor or can generate such an object, e.g. via a suitable method \code{\link{predict}}, which gives the cluster membership for each sample.} \item{y}{a factor or an object coerced into a factor that gives the true class labels for each sample. It may be missing if \code{x} is a contingency table.} \item{...}{extra arguments to allow extension, and usually passed to the next method.} \item{method}{a character string that specifies how the value is computed. It may be either \code{'best'} or \code{'mean'} to compute the best or mean purity respectively.} } \value{ a single numeric value the entropy (i.e. a single numeric value) } \description{ The functions \code{purity} and \code{entropy} respectively compute the purity and the entropy of a clustering given \emph{a priori} known classes. The purity and entropy measure the ability of a clustering method, to recover known classes (e.g. one knows the true class labels of each sample), that are applicable even when the number of cluster is different from the number of known classes. \cite{Kim et al. (2007)} used these measures to evaluate the performance of their alternate least-squares NMF algorithm. } \details{ Suppose we are given \eqn{l} categories, while the clustering method generates \eqn{k} clusters. The purity of the clustering with respect to the known categories is given by: \deqn{Purity = \frac{1}{n} \sum_{q=1}^k \max_{1 \leq j \leq l} n_q^j} , where: \itemize{ \item \eqn{n} is the total number of samples; \item \eqn{n_q^j} is the number of samples in cluster \eqn{q} that belongs to original class \eqn{j} (\eqn{1 \leq j \leq l}). } The purity is therefore a real number in \eqn{[0,1]}. The larger the purity, the better the clustering performance. The entropy of the clustering with respect to the known categories is given by: \deqn{Entropy = - \frac{1}{n \log_2 l} \sum_{q=1}^k \sum_{j=1}^l n_q^j \log_2 \frac{n_q^j}{n_q}}{ - 1/(n log2(l) ) sum_q sum_j n(q,j) log2( n(q,j) / n_q )}, where: \itemize{ \item \eqn{n} is the total number of samples; \item \eqn{n}{n_q} is the total number of samples in cluster \eqn{q} (\eqn{1 \leq q \leq k}); \item \eqn{n_q^j}{n(q,j)} is the number of samples in cluster \eqn{q} that belongs to original class \eqn{j} (\eqn{1 \leq j \leq l}). } The smaller the entropy, the better the clustering performance. } \section{Methods}{ \describe{ \item{entropy}{\code{signature(x = "table", y = "missing")}: Computes the purity directly from the contingency table \code{x}. This is the workhorse method that is eventually called by all other methods. } \item{entropy}{\code{signature(x = "factor", y = "ANY")}: Computes the purity on the contingency table of \code{x} and \code{y}, that is coerced into a factor if necessary. } \item{entropy}{\code{signature(x = "ANY", y = "ANY")}: Default method that should work for results of clustering algorithms, that have a suitable \code{predict} method that returns the cluster membership vector: the purity is computed between \code{x} and \code{predict{y}} } \item{entropy}{\code{signature(x = "NMFfitXn", y = "ANY")}: Computes the best or mean entropy across all NMF fits stored in \code{x}. } \item{purity}{\code{signature(x = "table", y = "missing")}: Computes the purity directly from the contingency table \code{x} } \item{purity}{\code{signature(x = "factor", y = "ANY")}: Computes the purity on the contingency table of \code{x} and \code{y}, that is coerced into a factor if necessary. } \item{purity}{\code{signature(x = "ANY", y = "ANY")}: Default method that should work for results of clustering algorithms, that have a suitable \code{predict} method that returns the cluster membership vector: the purity is computed between \code{x} and \code{predict{y}} } \item{purity}{\code{signature(x = "NMFfitXn", y = "ANY")}: Computes the best or mean purity across all NMF fits stored in \code{x}. } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # generate a synthetic dataset with known classes: 50 features, 18 samples (5+5+8) n <- 50; counts <- c(5, 5, 8); V <- syntheticNMF(n, counts) cl <- unlist(mapply(rep, 1:3, counts)) # perform default NMF with rank=2 x2 <- nmf(V, 2) purity(x2, cl) entropy(x2, cl) # perform default NMF with rank=2 x3 <- nmf(V, 3) purity(x3, cl) entropy(x3, cl) } \references{ Kim H and Park H (2007). "Sparse non-negative matrix factorizations via alternating non-negativity-constrained least squares for microarray data analysis." _Bioinformatics (Oxford, England)_, *23*(12), pp. 1495-502. ISSN 1460-2059, , . } \seealso{ Other assess: \code{\link{sparseness}} } \keyword{methods} NMF/man/nmf-compare.Rd0000644000176000001440000001513412305630424014173 0ustar ripleyusers\docType{methods} \name{compare-NMF} \alias{compare,list-method} \alias{compare-NMF} \alias{compare,NMFfit-method} \alias{consensusmap,list-method} \alias{consensusmap,NMF.rank-method} \alias{plot,NMFList,missing-method} \alias{summary,NMFList-method} \title{Comparing Results from Different NMF Runs} \usage{ \S4method{compare}{NMFfit}(object, ...) \S4method{compare}{list}(object, ...) \S4method{summary}{NMFList}(object, sort.by = NULL, select = NULL, ...) \S4method{plot}{NMFList,missing}(x, y, skip = -1, ...) \S4method{consensusmap}{NMF.rank}(object, ...) \S4method{consensusmap}{list}(object, layout, Rowv = FALSE, main = names(object), ...) } \arguments{ \item{...}{extra arguments passed by \code{compare} to \code{summary,NMFList} or to the \code{summary} method of each fit.} \item{select}{the columns to be output in the result \code{data.frame}. The column are given by their names (partially matched). The column names are the names of the summary measures returned by the \code{summary} methods of the corresponding NMF results.} \item{sort.by}{the sorting criteria, i.e. a partial match of a column name, by which the result \code{data.frame} is sorted. The sorting direction (increasing or decreasing) is computed internally depending on the chosen criteria (e.g. decreasing for the cophenetic coefficient, increasing for the residuals).} \item{x}{an \code{NMFList} object that contains fits from separate NMF runs.} \item{y}{missing} \item{layout}{specification of the layout. It may be a single numeric or a numeric couple, to indicate a square or rectangular layout respectively, that is filled row by row. It may also be a matrix that is directly passed to the function \code{\link[graphics]{layout}} from the package \code{graphics}.} \item{object}{an object computed using some algorithm, or that describes an algorithm itself.} \item{skip}{an integer that indicates the number of points to skip/remove from the beginning of the curve. If \code{skip=1L} (default) only the initial residual -- that is computed before any iteration, is skipped, if present in the track (it associated with iteration 0).} \item{Rowv}{clustering specification(s) for the rows. It allows to specify the distance/clustering/ordering/display parameters to be used for the \emph{rows only}. Possible values are: \itemize{ \item \code{TRUE} or \code{NULL} (to be consistent with \code{\link{heatmap}}): compute a dendrogram from hierarchical clustering using the distance and clustering methods \code{distfun} and \code{hclustfun}. \item \code{NA}: disable any ordering. In this case, and if not otherwise specified with argument \code{revC=FALSE}, the heatmap shows the input matrix with the rows in their original order, with the first row on top to the last row at the bottom. Note that this differ from the behaviour or \code{\link{heatmap}}, but seemed to be a more sensible choice when vizualizing a matrix without reordering. \item an integer vector of length the number of rows of the input matrix (\code{nrow(x)}), that specifies the row order. As in the case \code{Rowv=NA}, the ordered matrix is shown first row on top, last row at the bottom. \item a character vector or a list specifying values to use instead of arguments \code{distfun}, \code{hclustfun} and \code{reorderfun} when clustering the rows (see the respective argument descriptions for a list of accepted values). If \code{Rowv} has no names, then the first element is used for \code{distfun}, the second (if present) is used for \code{hclustfun}, and the third (if present) is used for \code{reorderfun}. \item a numeric vector of weights, of length the number of rows of the input matrix, used to reorder the internally computed dendrogram \code{d} by \code{reorderfun(d, Rowv)}. \item \code{FALSE}: the dendrogram \emph{is} computed using methods \code{distfun}, \code{hclustfun}, and \code{reorderfun} but is not shown. \item a single integer that specifies how many subtrees (i.e. clusters) from the computed dendrogram should have their root faded out. This can be used to better highlight the different clusters. \item a single double that specifies how much space is used by the computed dendrogram. That is that this value is used in place of \code{treeheight}. }} \item{main}{Main title as a character string or a grob.} } \description{ The functions documented here allow to compare the fits computed in different NMF runs. The fits do not need to be from the same algorithm, nor have the same dimension. } \details{ The methods \code{compare} enables to compare multiple NMF fits either passed as arguments or as a list of fits. These methods eventually call the method \code{summary,NMFList}, so that all its arguments can be passed \strong{named} in \code{...}. } \section{Methods}{ \describe{ \item{compare}{\code{signature(object = "NMFfit")}: Compare multiple NMF fits passed as arguments. } \item{compare}{\code{signature(object = "list")}: Compares multiple NMF fits passed as a standard list. } \item{consensusmap}{\code{signature(object = "NMF.rank")}: Draw a single plot with a heatmap of the consensus matrix obtained for each value of the rank, in the range tested with \code{\link{nmfEstimateRank}}. } \item{consensusmap}{\code{signature(object = "list")}: Draw a single plot with a heatmap of the consensus matrix of each element in the list \code{object}. } \item{plot}{\code{signature(x = "NMFList", y = "missing")}: \code{plot} plot on a single graph the residuals tracks for each fit in \code{x}. See function \code{\link{nmf}} for details on how to enable the tracking of residuals. } \item{summary}{\code{signature(object = "NMFList")}: \code{summary,NMFList} computes summary measures for each NMF result in the list and return them in rows in a \code{data.frame}. By default all the measures are included in the result, and \code{NA} values are used where no data is available or the measure does not apply to the result object (e.g. the dispersion for single' NMF runs is not meaningful). This method is very useful to compare and evaluate the performance of different algorithms. } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } #---------- # compare,NMFfit-method #---------- x <- rmatrix(20,10) res <- nmf(x, 3) res2 <- nmf(x, 2, 'lee') # compare arguments compare(res, res2, target=x) #---------- # compare,list-method #---------- # compare elements of a list compare(list(res, res2), target=x) } \keyword{methods} NMF/man/NMFOffset-class.Rd0000644000176000001440000000744412305630424014666 0ustar ripleyusers\docType{class} \name{NMFOffset-class} \alias{initialize,NMFOffset-method} \alias{NMFOffset-class} \title{NMF Model - Nonnegative Matrix Factorization with Offset} \usage{ \S4method{initialize}{NMFOffset}(.Object, ..., offset) } \arguments{ \item{offset}{optional numeric vector used to initialise slot \sQuote{offset}.} \item{.Object}{ An object: see the Details section.} \item{...}{data to include in the new object. Named arguments correspond to slots in the class definition. Unnamed arguments must be objects from classes that this class extends.} } \description{ This class implements the \emph{Nonnegative Matrix Factorization with Offset} model, required by the NMF with Offset algorithm. } \details{ The NMF with Offset algorithm is defined by \cite{Badea (2008)} as a modification of the euclidean based NMF algorithm from \code{Lee2001} (see section Details and references below). It aims at obtaining 'cleaner' factor matrices, by the introduction of an offset matrix, explicitly modelling a feature specific baseline -- constant across samples. } \section{Methods}{ \describe{ \item{fitted}{\code{signature(object = "NMFOffset")}: Computes the target matrix estimate for an NMFOffset object. The estimate is computed as: \deqn{ W H + offset } } \item{offset}{\code{signature(object = "NMFOffset")}: The function \code{offset} returns the offset vector from an NMF model that has an offset, e.g. an \code{NMFOffset} model. } \item{rnmf}{\code{signature(x = "NMFOffset", target = "numeric")}: Generates a random NMF model with offset, from class \code{NMFOffset}. The offset values are drawn from a uniform distribution between 0 and the maximum entry of the basis and coefficient matrices, which are drawn by the next suitable \code{\link{rnmf}} method, which is the workhorse method \code{rnmf,NMF,numeric}. } \item{show}{\code{signature(object = "NMFOffset")}: Show method for objects of class \code{NMFOffset} } } } \section{Creating objects from the Class}{ Object of class \code{NMFOffset} can be created using the standard way with operator \code{\link{new}} However, as for all NMF model classes -- that extend class \code{\linkS4class{NMF}}, objects of class \code{NMFOffset} should be created using factory method \code{\link{nmfModel}} : \code{new('NMFOffset')} \code{nmfModel(model='NMFOffset')} \code{nmfModel(model='NMFOffset', W=w, offset=rep(1, nrow(w)))} See \code{\link{nmfModel}} for more details on how to use the factory method. } \section{Initialize method}{ The initialize method for \code{NMFOffset} objects tries to correct the initial value passed for slot \code{offset}, so that it is consistent with the dimensions of the \code{NMF} model: it will pad the offset vector with NA values to get the length equal to the number of rows in the basis matrix. } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # create a completely empty NMF object new('NMFOffset') # create a NMF object based on random (compatible) matrices n <- 50; r <- 3; p <- 20 w <- rmatrix(n, r) h <- rmatrix(r, p) nmfModel(model='NMFOffset', W=w, H=h, offset=rep(0.5, nrow(w))) # apply Nonsmooth NMF algorithm to a random target matrix V <- rmatrix(n, p) \dontrun{nmf(V, r, 'offset')} # random NMF model with offset rnmf(3, 10, 5, model='NMFOffset') } \references{ Badea L (2008). "Extracting gene expression profiles common to colon and pancreatic adenocarcinoma using simultaneous nonnegative matrix factorization." _Pacific Symposium on Biocomputing. Pacific Symposium on Biocomputing_, *290*, pp. 267-78. ISSN 1793-5091, . } \seealso{ Other NMF-model: \code{\link{NMFns-class}}, \code{\link{NMFstd-class}} } \keyword{methods} NMF/man/heatmaps.Rd0000644000176000001440000003665512305630424013604 0ustar ripleyusers\docType{methods} \name{heatmap-NMF} \alias{basismap} \alias{basismap-methods} \alias{basismap,NMFfitX-method} \alias{basismap,NMF-method} \alias{coefmap} \alias{coefmap-methods} \alias{coefmap,NMFfitX-method} \alias{coefmap,NMF-method} \alias{consensusmap} \alias{consensusmap,matrix-method} \alias{consensusmap-methods} \alias{consensusmap,NMFfitX-method} \alias{consensusmap,NMF-method} \alias{heatmap-NMF} \title{Heatmaps of NMF Factors} \usage{ basismap(object, ...) \S4method{basismap}{NMF}(object, color = "YlOrRd:50", scale = "r1", Rowv = TRUE, Colv = NA, subsetRow = FALSE, annRow = NA, annCol = NA, tracks = "basis", main = "Basis components", info = FALSE, ...) coefmap(object, ...) \S4method{coefmap}{NMF}(object, color = "YlOrRd:50", scale = "c1", Rowv = NA, Colv = TRUE, annRow = NA, annCol = NA, tracks = "basis", main = "Mixture coefficients", info = FALSE, ...) consensusmap(object, ...) \S4method{consensusmap}{NMFfitX}(object, annRow = NA, annCol = NA, tracks = c("basis:", "consensus:", "silhouette:"), main = "Consensus matrix", info = FALSE, ...) \S4method{consensusmap}{matrix}(object, color = "-RdYlBu", distfun = function(x) as.dist(1 - x), hclustfun = "average", Rowv = TRUE, Colv = "Rowv", main = if (is.null(nr) || nr > 1) "Consensus matrix" else "Connectiviy matrix", info = FALSE, ...) \S4method{coefmap}{NMFfitX}(object, Colv = TRUE, annRow = NA, annCol = NA, tracks = c("basis", "consensus:"), ...) } \arguments{ \item{object}{an object from which is extracted NMF factors or a consensus matrix} \item{...}{extra arguments passed to \code{\link{aheatmap}}.} \item{subsetRow}{Argument that specifies how to filter the rows that will appear in the heatmap. When \code{FALSE} (default), all rows are used. Besides the values supported by argument \code{subsetRow} of \code{\link{aheatmap}}, other possible values are: \itemize{ \item \code{TRUE}: only the rows that are basis-specific are used. The default selection method is from \cite{KimH2007}. This is equivalent to \code{subsetRow='kim'}. \item a single \code{character} string or numeric value that specifies the method to use to select the basis-specific rows, that should appear in the heatmap (cf. argument \code{method} for function \code{\link{extractFeatures}}). Note \code{\link{extractFeatures}} is called with argument \code{nodups=TRUE}, so that features that are selected for multiple components only appear once. }} \item{tracks}{Special additional annotation tracks to highlight associations between basis components and sample clusters: \describe{ \item{basis}{matches each row (resp. column) to the most contributing basis component in \code{basismap} (resp. \code{coefmap}). In \code{basismap} (resp. \code{coefmap}), adding a track \code{':basis'} to \code{annCol} (resp. \code{annRow}) makes the column (resp. row) corresponding to the component being also highlited using the mathcing colours.} }} \item{info}{if \code{TRUE} then the name of the algorithm that fitted the NMF model is displayed at the bottom of the plot, if available. Other wise it is passed as is to \code{aheatmap}.} \item{color}{colour specification for the heatmap. Default to palette '-RdYlBu2:100', i.e. reversed palette 'RdYlBu2' (a slight modification of RColorBrewer's palette 'RdYlBu') with 100 colors. Possible values are: \itemize{ \item a character/integer vector of length greater than 1 that is directly used and assumed to contain valid R color specifications. \item a single color/integer (between 0 and 8)/other numeric value that gives the dominant colors. Numeric values are converted into a pallete by \code{rev(sequential_hcl(2, h = x, l = c(50, 95)))}. Other values are concatenated with the grey colour '#F1F1F1'. \item one of RColorBrewer's palette name (see \code{\link[RColorBrewer]{display.brewer.all}}) , or one of 'RdYlBu2', 'rainbow', 'heat', 'topo', 'terrain', 'cm'. } When the coluor palette is specified with a single value, and is negative or preceded a minus ('-'), the reversed palette is used. The number of breaks can also be specified after a colon (':'). For example, the default colour palette is specified as '-RdYlBu2:100'.} \item{scale}{character indicating how the values should scaled in either the row direction or the column direction. Note that the scaling is performed after row/column clustering, so that it has no effect on the row/column ordering. Possible values are: \itemize{ \item \code{"row"}: center and standardize each row separately to row Z-scores \item \code{"column"}: center and standardize each column separately to column Z-scores \item \code{"r1"}: scale each row to sum up to one \item \code{"c1"}: scale each column to sum up to one \item \code{"none"}: no scaling }} \item{Rowv}{clustering specification(s) for the rows. It allows to specify the distance/clustering/ordering/display parameters to be used for the \emph{rows only}. Possible values are: \itemize{ \item \code{TRUE} or \code{NULL} (to be consistent with \code{\link{heatmap}}): compute a dendrogram from hierarchical clustering using the distance and clustering methods \code{distfun} and \code{hclustfun}. \item \code{NA}: disable any ordering. In this case, and if not otherwise specified with argument \code{revC=FALSE}, the heatmap shows the input matrix with the rows in their original order, with the first row on top to the last row at the bottom. Note that this differ from the behaviour or \code{\link{heatmap}}, but seemed to be a more sensible choice when vizualizing a matrix without reordering. \item an integer vector of length the number of rows of the input matrix (\code{nrow(x)}), that specifies the row order. As in the case \code{Rowv=NA}, the ordered matrix is shown first row on top, last row at the bottom. \item a character vector or a list specifying values to use instead of arguments \code{distfun}, \code{hclustfun} and \code{reorderfun} when clustering the rows (see the respective argument descriptions for a list of accepted values). If \code{Rowv} has no names, then the first element is used for \code{distfun}, the second (if present) is used for \code{hclustfun}, and the third (if present) is used for \code{reorderfun}. \item a numeric vector of weights, of length the number of rows of the input matrix, used to reorder the internally computed dendrogram \code{d} by \code{reorderfun(d, Rowv)}. \item \code{FALSE}: the dendrogram \emph{is} computed using methods \code{distfun}, \code{hclustfun}, and \code{reorderfun} but is not shown. \item a single integer that specifies how many subtrees (i.e. clusters) from the computed dendrogram should have their root faded out. This can be used to better highlight the different clusters. \item a single double that specifies how much space is used by the computed dendrogram. That is that this value is used in place of \code{treeheight}. }} \item{Colv}{clustering specification(s) for the columns. It accepts the same values as argument \code{Rowv} (modulo the expected length for vector specifications), and allow specifying the distance/clustering/ordering/display parameters to be used for the \emph{columns only}. \code{Colv} may also be set to \code{"Rowv"}, in which case the dendrogram or ordering specifications applied to the rows are also applied to the columns. Note that this is allowed only for square input matrices, and that the row ordering is in this case by default reversed (\code{revC=TRUE}) to obtain the diagonal in the standard way (from top-left to bottom-right). See argument \code{Rowv} for other possible values.} \item{annRow}{specifications of row annotation tracks displayed as coloured columns on the left of the heatmaps. The annotation tracks are drawn from left to right. The same conversion, renaming and colouring rules as for argument \code{annCol} apply.} \item{annCol}{specifications of column annotation tracks displayed as coloured rows on top of the heatmaps. The annotation tracks are drawn from bottom to top. A single annotation track can be specified as a single vector; multiple tracks are specified as a list, a data frame, or an \code{\link[Biobase:ExpressionSet-class]{ExpressionSet}} object, in which case the phenotypic data is used (\code{pData(eset)}). Character or integer vectors are converted and displayed as factors. Unnamed tracks are internally renamed into \code{Xi}, with i being incremented for each unamed track, across both column and row annotation tracks. For each track, if no corresponding colour is specified in argument \code{annColors}, a palette or a ramp is automatically computed and named after the track's name.} \item{main}{Main title as a character string or a grob.} \item{distfun}{default distance measure used in clustering rows and columns. Possible values are: \itemize{ \item all the distance methods supported by \code{\link{dist}} (e.g. "euclidean" or "maximum"). \item all correlation methods supported by \code{\link{cor}}, such as \code{"pearson"} or \code{"spearman"}. The pairwise distances between rows/columns are then computed as \code{d <- dist(1 - cor(..., method = distfun))}. One may as well use the string "correlation" which is an alias for "pearson". \item an object of class \code{dist} such as returned by \code{\link{dist}} or \code{\link{as.dist}}. }} \item{hclustfun}{default clustering method used to cluster rows and columns. Possible values are: \itemize{ \item a method name (a character string) supported by \code{\link{hclust}} (e.g. \code{'average'}). \item an object of class \code{hclust} such as returned by \code{\link{hclust}} \item a dendrogram }} } \description{ The NMF package ships an advanced heatmap engine implemented by the function \code{\link{aheatmap}}. Some convenience heatmap functions have been implemented for NMF models, which redefine default values for some of the arguments of \code{\link{aheatmap}}, hence tuning the output specifically for NMF models. } \details{ \strong{IMPORTANT:} although they essentially have the same set of arguments, their order sometimes differ between them, as well as from \code{\link{aheatmap}}. We therefore strongly recommend to use fully named arguments when calling these functions. \code{basimap} default values for the following arguments of \code{\link{aheatmap}}: \itemize{ \item the color palette; \item the scaling specification, which by default scales each row separately so that they sum up to one (\code{scale='r1'}); \item the column ordering which is disabled; \item allowing for passing feature extraction methods in argument \code{subsetRow}, that are passed to \code{\link{extractFeatures}}. See argument description here and therein. \item the addition of a default named annotation track, that shows the dominant basis component for each row (i.e. each feature). This track is specified in argument \code{tracks} (see its argument description). By default, a matching column annotation track is also displayed, but may be disabled using \code{tracks=':basis'}. \item a suitable title and extra information like the fitting algorithm, when \code{object} is a fitted NMF model. } \code{coefmap} redefines default values for the following arguments of \code{\link{aheatmap}}: \itemize{ \item the color palette; \item the scaling specification, which by default scales each column separately so that they sum up to one (\code{scale='c1'}); \item the row ordering which is disabled; \item the addition of a default annotation track, that shows the most contributing basis component for each column (i.e. each sample). This track is specified in argument \code{tracks} (see its argument description). By default, a matching row annotation track is also displayed, but can be disabled using \code{tracks='basis:'}. \item a suitable title and extra information like the fitting algorithm, when \code{object} is a fitted NMF model. } \code{consensusmap} redefines default values for the following arguments of \code{\link{aheatmap}}: \itemize{ \item the colour palette; \item the column ordering which is set equal to the row ordering, since a consensus matrix is symmetric; \item the distance and linkage methods used to order the rows (and columns). The default is to use 1 minus the consensus matrix itself as distance, and average linkage. \item the addition of two special named annotation tracks, \code{'basis:'} and \code{'consensus:'}, that show, for each column (i.e. each sample), the dominant basis component in the best fit and the hierarchical clustering of the consensus matrix respectively (using 1-consensus as distance and average linkage). These tracks are specified in argument \code{tracks}, which behaves as in \code{\link{basismap}}. \item a suitable title and extra information like the type of NMF model or the fitting algorithm, when \code{object} is a fitted NMF model. } } \section{Methods}{ \describe{ \item{basismap}{\code{signature(object = "NMF")}: Plots a heatmap of the basis matrix of the NMF model \code{object}. This method also works for fitted NMF models (i.e. \code{NMFfit} objects). } \item{basismap}{\code{signature(object = "NMFfitX")}: Plots a heatmap of the basis matrix of the best fit in \code{object}. } \item{coefmap}{\code{signature(object = "NMF")}: The default method for NMF objects has special default values for some arguments of \code{\link{aheatmap}} (see argument description). } \item{coefmap}{\code{signature(object = "NMFfitX")}: Plots a heatmap of the coefficient matrix of the best fit in \code{object}. This method adds: \itemize{ \item an extra special column annotation track for multi-run NMF fits, \code{'consensus:'}, that shows the consensus cluster associated to each sample. \item a column sorting schema \code{'consensus'} that can be passed to argument \code{Colv} and orders the columns using the hierarchical clustering of the consensus matrix with average linkage, as returned by \code{\link{consensushc}(object)}. This is also the ordering that is used by default for the heatmap of the consensus matrix as ploted by \code{\link{consensusmap}}. } } \item{consensusmap}{\code{signature(object = "NMFfitX")}: Plots a heatmap of the consensus matrix obtained when fitting an NMF model with multiple runs. } \item{consensusmap}{\code{signature(object = "NMF")}: Plots a heatmap of the connectivity matrix of an NMF model. } \item{consensusmap}{\code{signature(object = "matrix")}: Main method that redefines default values for arguments of \code{\link{aheatmap}}. } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } #---------- # heatmap-NMF #---------- ## More examples are provided in demo `heatmaps` \dontrun{ demo(heatmaps) } ## # random data with underlying NMF model v <- syntheticNMF(20, 3, 10) # estimate a model x <- nmf(v, 3) #---------- # basismap #---------- # show basis matrix basismap(x) \dontrun{ # without the default annotation tracks basismap(x, tracks=NA) } #---------- # coefmap #---------- # coefficient matrix coefmap(x) \dontrun{ # without the default annotation tracks coefmap(x, tracks=NA) } #---------- # consensusmap #---------- \dontrun{ res <- nmf(x, 3, nrun=3) consensusmap(res) } } \keyword{methods} NMF/man/NMFStrategyOctave-class.Rd0000644000176000001440000000417112234465004016377 0ustar ripleyusers\docType{class} \name{NMFStrategyOctave-class} \alias{NMFStrategyOctave-class} \alias{show,NMFStrategyOctave-method} \title{S4 Interface for Octave-Matlab NMF Algorithms} \usage{ \S4method{show}{NMFStrategyOctave}(object) } \arguments{ \item{object}{Any R object} } \description{ This class implements the virtual interface \code{\linkS4class{NMFStrategy}} for NMF algorithms that are implemented in Octave/Matlab, and provided as a set of .m files or as plain code. } \details{ The \code{run} method for this class runs the algorithms via the \code{\link[RcppOctave]{RcppOctave}} package. } \section{Slots}{ \describe{ \item{algorithm}{character string that gives the name of the main Octave/Matlab function that implements the algorithm. The function must take at least two arguments: the target matrix and the initial NMF model, converted into an Octave list object, with elements corresponding to slots of the corresponding S4 class.} \item{mcode}{character vector that contains a set of path to .m files. These files are (re-)sourced every time the strategy is called, and must be present at runtime in the current directory or in a directory from Octave path.} } } \section{Methods}{ \describe{ \item{algorithm}{\code{signature(object = "NMFStrategyOctave")}: Returns the name of the Octave/Matlab function that implements the NMF algorithm -- as stored in slot \code{algorithm}. } \item{algorithm<-}{\code{signature(object = "NMFStrategyOctave", value = "character")}: Sets the name of the Octave/Matlab function that implements the NMF algorithm. It is stored in slot \code{algorithm}. } \item{run}{\code{signature(object = "NMFStrategyOctave", y = "matrix", x = "NMFfit")}: Runs the NMF algorithms implemented by the Octave/Matlab function associated with the strategy -- and stored in slot \code{'algorithm'} of \code{object}. This method is usually not called directly, but only via the function \code{\link{nmf}}, which takes care of many other details such as seeding the computation, handling RNG settings, or setting up parallel computations. } } } \keyword{methods} NMF/man/dims.Rd0000644000176000001440000000577612234465004012737 0ustar ripleyusers\docType{methods} \name{nbasis} \alias{dim-NMF} \alias{dim,NMFfitXn-method} \alias{dim,NMF-method} \alias{nbasis} \alias{nbasis,ANY-method} \alias{nbasis-methods} \alias{nbasis,NMFfitXn-method} \title{Dimension of NMF Objects} \usage{ nbasis(x, ...) \S4method{dim}{NMF}(x) \S4method{dim}{NMFfitXn}(x) } \arguments{ \item{x}{an object with suitable \code{basis} and \code{coef} methods, such as an object that inherit from \code{\linkS4class{NMF}}.} \item{...}{extra arguments to allow extension.} } \value{ a single integer value or, for \code{dim}, a length-3 integer vector, e.g. \code{c(2000, 30, 3)} for an \code{NMF} model that fits a 2000 x 30 matrix using 3 basis components. } \description{ The methods \code{dim}, \code{nrow}, \code{ncol} and \code{nbasis} return the different dimensions associated with an NMF model. \code{dim} returns all dimensions in a length-3 integer vector: the number of row and columns of the estimated target matrix, as well as the factorization rank (i.e. the number of basis components). \code{nrow}, \code{ncol} and \code{nbasis} provide separate access to each of these dimensions respectively. } \details{ The NMF package does not implement specific functions \code{nrow} and \code{ncol}, but rather the S4 method \code{dim} for objects of class \code{\linkS4class{NMF}}. This allows the base methods \code{\link{nrow}} and \code{\link{ncol}} to directly work with such objects, to get the number of rows and columns of the target matrix estimated by an NMF model. The function \code{nbasis} is a new S4 generic defined in the package NMF, that returns the number of basis components of an object. Its default method should work for any object, that has a suitable \code{basis} method defined for its class. } \section{Methods}{ \describe{ \item{dim}{\code{signature(x = "NMF")}: method for NMF objects for the base generic \code{\link{dim}}. It returns all dimensions in a length-3 integer vector: the number of row and columns of the estimated target matrix, as well as the factorization rank (i.e. the number of basis components). } \item{dim}{\code{signature(x = "NMFfitXn")}: Returns the dimension common to all fits. Since all fits have the same dimensions, it returns the dimension of the first fit. This method returns \code{NULL} if the object is empty. } \item{nbasis}{\code{signature(x = "ANY")}: Default method which returns the number of columns of the basis matrix extracted from \code{x} using a suitable method \code{basis}, or, if the latter is \code{NULL}, the value of attributes \code{'nbasis'}. For NMF models, this also corresponds to the number of rows in the coefficient matrix. } \item{nbasis}{\code{signature(x = "NMFfitXn")}: Returns the number of basis components common to all fits. Since all fits have been computed using the same rank, it returns the factorization rank of the first fit. This method returns \code{NULL} if the object is empty. } } } \keyword{methods} NMF/man/nmfReport.Rd0000644000176000001440000000270512305630424013743 0ustar ripleyusers\name{nmfReport} \alias{nmfReport} \title{Run NMF Methods and Generate a Report} \usage{ nmfReport(x, rank, method, colClass = NULL, ..., output = NULL, template = NULL) } \arguments{ \item{x}{target matrix} \item{rank}{factorization rank} \item{method}{list of methods to apply} \item{colClass}{reference class to assess accuracy} \item{...}{extra paramters passed to \code{\link{nmf}}} \item{output}{output HTML file} \item{template}{template Rmd file} } \value{ a list with the following elements: \item{fits}{the fit(s) for each method and each value of the rank.} \item{accuracy}{a data.frame that contains the summary assessment measures, for each fit.} } \description{ Generates an HTML report from running a set of method on a given target matrix, for a set of factorization ranks. } \details{ The report is based on an .Rmd document \code{'report.Rmd'} stored in the package installation sub-directory \code{scripts/}, and is compiled using \pkg{knitr}. At the beginning of the document, a file named \code{'functions.R'} is looked for in the current directory, and sourced if present. This enables the definition of custom NMF methods (see \code{\link{setNMFMethod}}) or setting global options. } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } \dontrun{ x <- rmatrix(20, 10) gr <- gl(2, 5) nmfReport(x, 2:4, method = list('br', 'lee'), colClass = gr, nrun = 5) } } NMF/man/stop-NMF.Rd0000644000176000001440000001124412305630424013370 0ustar ripleyusers\name{NMFStop} \alias{NMFStop} \alias{nmf.stop.connectivity} \alias{nmf.stop.iteration} \alias{nmf.stop.stationary} \alias{nmf.stop.threshold} \alias{stop-NMF} \title{Stopping Criteria for NMF Iterative Strategies} \usage{ NMFStop(s, check = TRUE) nmf.stop.iteration(n) nmf.stop.threshold(threshold) nmf.stop.stationary(object, i, y, x, stationary.th = .Machine$double.eps, check.interval = 5 * check.niter, check.niter = 10L, ...) nmf.stop.connectivity(object, i, y, x, stopconv = 40, check.interval = 10, ...) } \arguments{ \item{s}{specification of the stopping criterion. See section \emph{Details} for the supported formats and how they are processed.} \item{check}{logical that indicates if the validity of the stopping criterion function should be checked before returning it.} \item{n}{maximum number of iteration to perform.} \item{threshold}{default stationarity threshold} \item{object}{an NMF strategy object} \item{i}{the current iteration} \item{y}{the target matrix} \item{x}{the current NMF model} \item{stationary.th}{maximum absolute value of the gradient, for the objective function to be considered stationary.} \item{check.interval}{interval (in number of iterations) on which the stopping criterion is computed.} \item{check.niter}{number of successive iteration used to compute the stationnary criterion.} \item{...}{extra arguments passed to the function \code{\link{objective}}, which computes the objective value between \code{x} and \code{y}.} \item{stopconv}{number of iterations intervals over which the connectivity matrix must not change for stationarity to be achieved.} } \value{ a function that can be passed to argument \code{.stop} of function \code{\link{nmf}}, which is typically used when the algorith is implemented as an iterative strategy. a function that can be used as a stopping criterion for NMF algorithms defined as \code{\linkS4class{NMFStrategyIterative}} objects. That is a function with arguments \code{(strategy, i, target, data, ...)} that returns \code{TRUE} if the stopping criterion is satisfied -- which in turn stops the iterative process, and \code{FALSE} otherwise. } \description{ The function documented here implement stopping/convergence criteria commonly used in NMF algorithms. \code{NMFStop} acts as a factory method that creates stopping criterion functions from different types of values, which are subsequently used by \code{\linkS4class{NMFStrategyIterative}} objects to determine when to stop their iterative process. \code{nmf.stop.iteration} generates a function that implements the stopping criterion that limits the number of iterations to a maximum of \code{n}), i.e. that returns \code{TRUE} if \code{i>=n}, \code{FALSE} otherwise. \code{nmf.stop.threshold} generates a function that implements the stopping criterion that stops when a given stationarity threshold is achieved by successive iterations. The returned function is identical to \code{nmf.stop.stationary}, but with the default threshold set to \code{threshold}. More precisely, the objective function is computed over \eqn{n} successive iterations (specified in argument \code{check.niter}), every \code{check.interval} iterations. The criterion stops when the absolute difference between the maximum and the minimum objective values over these iterations is lower than a given threshold \eqn{\alpha} (specified in \code{stationary.th}): \code{nmf.stop.connectivity} implements the stopping criterion that is based on the stationarity of the connectivity matrix. } \details{ \code{NMFStop} can take the following values: \describe{ \item{function}{ is returned unchanged, except when it has no arguments, in which case it assumed to be a generator, which is immediately called and should return a function that implements the actual stopping criterion;} \item{integer}{ the value is used to create a stopping criterion that stops at that exact number of iterations via \code{nmf.stop.iteration};} \item{numeric}{ the value is used to create a stopping criterion that stops when at that stationary threshold via \code{nmf.stop.threshold};} \item{character}{ must be a single string which must be an access key for registered criteria (currently available: \dQuote{connectivity} and \dQuote{stationary}), or the name of a function in the global environment or the namespace of the loading package.} } \deqn{ \left| \frac{\max_{i- N_s + 1 \leq k \leq i} D_k - \min_{i - N_s +1 \leq k \leq i} D_k}{n} \right| \leq \alpha, }{ | [max( D(i- N_s + 1), ..., D(i) ) - min( D(i- N_s + 1), ..., D(i) )] / n | <= alpha } } NMF/man/inplace.Rd0000644000176000001440000000176712234465004013412 0ustar ripleyusers\name{pmax.inplace} \alias{neq.constraints.inplace} \alias{pmax.inplace} \title{Updating Objects In Place} \usage{ pmax.inplace(x, lim, skip = NULL) neq.constraints.inplace(x, constraints, ratio = NULL, value = NULL, copy = FALSE) } \arguments{ \item{x}{an object to update in place.} \item{lim}{lower threshold value} \item{skip}{indexes to skip} \item{constraints}{constraint specification.} \item{ratio}{fixed ratio on which the constraint applies.} \item{value}{fixed value to enforce.} \item{copy}{a logical that indicates if \code{x} should be updated in place or not.} } \description{ These functions modify objects (mainly matrix objects) in place, i.e. they act directly on the C pointer. Due to their side-effect, they are not meant to be called by the end-user. \code{neq.constraints.inplace} apply unequality constraints in place. } \details{ \code{pmax.inplace} is a version of \code{\link{pmax}} that updates its first argument. } \keyword{internal} NMF/man/algorithmic.Rd0000644000176000001440000003323512305630424014273 0ustar ripleyusers\docType{methods} \name{algorithmic-NMF} \alias{algorithm} \alias{algorithm<-} \alias{algorithmic-NMF} \alias{algorithm<--methods} \alias{algorithm-methods} \alias{algorithm<-,NMFfit,ANY-method} \alias{algorithm,NMFfit-method} \alias{algorithm,NMFfitXn-method} \alias{algorithm<-,NMFSeed,function-method} \alias{algorithm,NMFSeed-method} \alias{algorithm<-,NMFStrategyFunction,function-method} \alias{algorithm,NMFStrategyFunction-method} \alias{algorithm<-,NMFStrategyOctave,character-method} \alias{compare} \alias{compare-methods} \alias{compare,NMFfitXn-method} \alias{logs} \alias{logs,ANY-method} \alias{logs-methods} \alias{modelname} \alias{modelname,ANY-method} \alias{modelname-methods} \alias{modelname,NMFfit-method} \alias{modelname,NMFfitXn-method} \alias{modelname,NMFStrategy-method} \alias{niter} \alias{niter<-} \alias{niter<--methods} \alias{niter-methods} \alias{niter,NMFfit-method} \alias{niter<-,NMFfit,numeric-method} \alias{nrun} \alias{nrun,ANY-method} \alias{nrun-methods} \alias{nrun,NMFfit-method} \alias{nrun,NMFfitX1-method} \alias{nrun,NMFfitX-method} \alias{nrun,NMFfitXn-method} \alias{objective} \alias{objective<-} \alias{objective<--methods} \alias{objective-methods} \alias{objective<-,NMFfit,ANY-method} \alias{run} \alias{run-methods} \alias{runtime} \alias{runtime.all} \alias{runtime.all-methods} \alias{runtime.all,NMFfit-method} \alias{runtime.all,NMFfitX-method} \alias{runtime-methods} \alias{runtime,NMFfit-method} \alias{seeding} \alias{seeding<-} \alias{seeding<--methods} \alias{seeding-methods} \alias{seeding<-,NMFfit-method} \alias{seeding,NMFfit-method} \alias{seeding,NMFfitXn-method} \alias{seqtime} \alias{seqtime-methods} \alias{seqtime,NMFfitXn-method} \alias{seqtime,NMFList-method} \title{Generic Interface for Algorithms} \usage{ algorithm(object, ...) algorithm(object, ...)<-value seeding(object, ...) seeding(object, ...)<-value niter(object, ...) niter(object, ...)<-value nrun(object, ...) objective(object, ...) objective(object, ...)<-value runtime(object, ...) runtime.all(object, ...) seqtime(object, ...) modelname(object, ...) run(object, y, x, ...) logs(object, ...) compare(object, ...) } \arguments{ \item{object}{an object computed using some algorithm, or that describes an algorithm itself.} \item{value}{replacement value} \item{...}{extra arguments to allow extension} \item{y}{data object, e.g. a target matrix} \item{x}{a model object used as a starting point by the algorithm, e.g. a non-empty NMF model.} } \description{ The functions documented here are S4 generics that define an general interface for -- optimisation -- algorithms. This interface builds upon the broad definition of an algorithm as a workhorse function to which is associated auxiliary objects such as an underlying model or an objective function that measures the adequation of the model with observed data. It aims at complementing the interface provided by the \code{\link{stats}} package. } \details{ \code{algorithm} and \code{algorithm<-} get/set an object that describes the algorithm used to compute another object, or with which it is associated. It may be a simple character string that gives the algorithm's names, or an object that includes the algorithm's definition itself (e.g. an \code{\link{NMFStrategy}} object). \code{seeding} get/set the seeding method used to initialise the computation of an object, i.e. usually the function that sets the starting point of an algorithm. \code{niter} and \code{niter<-} get/set the number of iterations performed to compute an object. The function \code{niter<-} would usually be called just before returning the result of an algorithm, when putting together data about the fit. \code{nrun} returns the number of times the algorithm has been run to compute an object. Usually this will be 1, but may be be more if the algorithm involves multiple starting points. \code{objective} and \code{objective<-} get/set the objective function associated with an object. Some methods for \code{objective} may also compute the objective value with respect to some target/observed data. \code{runtime} returns the CPU time required to compute an object. This would generally be an object of class \code{\link[=proc.time]{proc_time}}. \code{runtime.all} returns the CPU time required to compute a collection of objects, e.g. a sequence of independent fits. \code{seqtime} returns the sequential CPU time -- that would be -- required to compute a collection of objects. It would differ from \code{runtime.all} if the computations were performed in parallel. \code{modelname} returns a the type of model associated with an object. \code{run} calls the workhorse function that actually implements a strategy/algorithm, and run it on some data object. \code{logs} returns the log messages output during the computation of an object. \code{compare} compares objects obtained from running separate algorithms. } \section{Methods}{ \describe{ \item{algorithm}{\code{signature(object = "NMFfit")}: Returns the name of the algorithm that fitted the NMF model \code{object}. } \item{algorithm}{\code{signature(object = "NMFList")}: Returns the method names used to compute the NMF fits in the list. It returns \code{NULL} if the list is empty. See \code{\link{algorithm,NMFList-method}} for more details. } \item{algorithm}{\code{signature(object = "NMFfitXn")}: Returns the name of the common NMF algorithm used to compute all fits stored in \code{object} Since all fits are computed with the same algorithm, this method returns the name of algorithm that computed the first fit. It returns \code{NULL} if the object is empty. } \item{algorithm}{\code{signature(object = "NMFSeed")}: Returns the workhorse function of the seeding method described by \code{object}. } \item{algorithm}{\code{signature(object = "NMFStrategyFunction")}: Returns the single R function that implements the NMF algorithm -- as stored in slot \code{algorithm}. } \item{algorithm}{\code{signature(object = "NMFStrategyOctave")}: Returns the name of the Octave/Matlab function that implements the NMF algorithm -- as stored in slot \code{algorithm}. See \code{\link{algorithm,NMFStrategyOctave-method}} for more details. } \item{algorithm<-}{\code{signature(object = "NMFSeed", value = "function")}: Sets the workhorse function of the seeding method described by \code{object}. } \item{algorithm<-}{\code{signature(object = "NMFStrategyFunction", value = "function")}: Sets the function that implements the NMF algorithm, stored in slot \code{algorithm}. } \item{algorithm<-}{\code{signature(object = "NMFStrategyOctave", value = "character")}: Sets the name of the Octave/Matlab function that implements the NMF algorithm. It is stored in slot \code{algorithm}. } \item{compare}{\code{signature(object = "NMFfitXn")}: Compares the fits obtained by separate runs of NMF, in a single call to \code{\link{nmf}}. } \item{logs}{\code{signature(object = "ANY")}: Default method that returns the value of attribute/slot \code{'logs'} or, if this latter does not exists, the value of element \code{'logs'} if \code{object} is a \code{list}. It returns \code{NULL} if no logging data was found. } \item{modelname}{\code{signature(object = "ANY")}: Default method which returns the class name(s) of \code{object}. This should work for objects representing models on their own. For NMF objects, this is the type of NMF model, that corresponds to the name of the S4 sub-class of \code{\linkS4class{NMF}}, inherited by \code{object}. } \item{modelname}{\code{signature(object = "NMFfit")}: Returns the type of a fitted NMF model. It is a shortcut for \code{modelname(fit(object)}. } \item{modelname}{\code{signature(object = "NMFfitXn")}: Returns the common type NMF model of all fits stored in \code{object} Since all fits are from the same NMF model, this method returns the model type of the first fit. It returns \code{NULL} if the object is empty. } \item{modelname}{\code{signature(object = "NMFStrategy")}: Returns the model(s) that an NMF algorithm can fit. } \item{niter}{\code{signature(object = "NMFfit")}: Returns the number of iteration performed to fit an NMF model, typically with function \code{\link{nmf}}. Currently this data is stored in slot \code{'extra'}, but this might change in the future. } \item{niter<-}{\code{signature(object = "NMFfit", value = "numeric")}: Sets the number of iteration performed to fit an NMF model. This function is used internally by the function \code{\link{nmf}}. It is not meant to be called by the user, except when developing new NMF algorithms implemented as single function, to set the number of iterations performed by the algorithm on the seed, before returning it (see \code{\linkS4class{NMFStrategyFunction}}). } \item{nrun}{\code{signature(object = "ANY")}: Default method that returns the value of attribute \sQuote{nrun}. Such an attribute my be attached to objects to keep track of data about the parent fit object (e.g. by method \code{\link{consensus}}), which can be used by subsequent function calls such as plot functions (e.g. see \code{\link{consensusmap}}). This method returns \code{NULL} if no suitable data was found. } \item{nrun}{\code{signature(object = "NMFfitX")}: Returns the number of NMF runs performed to create \code{object}. It is a pure virtual method defined to ensure \code{nrun} is defined for sub-classes of \code{NMFfitX}, which throws an error if called. Note that because the \code{\link{nmf}} function allows to run the NMF computation keeping only the best fit, \code{nrun} may return a value greater than one, while only the result of the best run is stored in the object (cf. option \code{'k'} in method \code{\link{nmf}}). } \item{nrun}{\code{signature(object = "NMFfit")}: This method always returns 1, since an \code{NMFfit} object is obtained from a single NMF run. } \item{nrun}{\code{signature(object = "NMFfitX1")}: Returns the number of NMF runs performed, amongst which \code{object} was selected as the best fit. } \item{nrun}{\code{signature(object = "NMFfitXn")}: Returns the number of runs performed to compute the fits stored in the list (i.e. the length of the list itself). } \item{objective}{\code{signature(object = "NMFfit")}: Returns the objective function associated with the algorithm that computed the fitted NMF model \code{object}, or the objective value with respect to a given target matrix \code{y} if it is supplied. See \code{\link{objective,NMFfit-method}} for more details. } \item{runtime}{\code{signature(object = "NMFfit")}: Returns the CPU time required to compute a single NMF fit. } \item{runtime}{\code{signature(object = "NMFList")}: Returns the CPU time required to compute all NMF fits in the list. It returns \code{NULL} if the list is empty. If no timing data are available, the sequential time is returned. See \code{\link{runtime,NMFList-method}} for more details. } \item{runtime.all}{\code{signature(object = "NMFfit")}: Identical to \code{runtime}, since their is a single fit. } \item{runtime.all}{\code{signature(object = "NMFfitX")}: Returns the CPU time required to compute all the NMF runs. It returns \code{NULL} if no CPU data is available. } \item{runtime.all}{\code{signature(object = "NMFfitXn")}: If no time data is available from in slot \sQuote{runtime.all} and argument \code{null=TRUE}, then the sequential time as computed by \code{\link{seqtime}} is returned, and a warning is thrown unless \code{warning=FALSE}. See \code{\link{runtime.all,NMFfitXn-method}} for more details. } \item{seeding}{\code{signature(object = "NMFfit")}: Returns the name of the seeding method that generated the starting point for the NMF algorithm that fitted the NMF model \code{object}. } \item{seeding}{\code{signature(object = "NMFfitXn")}: Returns the name of the common seeding method used the computation of all fits stored in \code{object} Since all fits are seeded using the same method, this method returns the name of the seeding method used for the first fit. It returns \code{NULL} if the object is empty. } \item{seqtime}{\code{signature(object = "NMFList")}: Returns the CPU time that would be required to sequentially compute all NMF fits stored in \code{object}. This method calls the function \code{runtime} on each fit and sum up the results. It returns \code{NULL} on an empty object. } \item{seqtime}{\code{signature(object = "NMFfitXn")}: Returns the CPU time that would be required to sequentially compute all NMF fits stored in \code{object}. This method calls the function \code{runtime} on each fit and sum up the results. It returns \code{NULL} on an empty object. } } } \section{Interface fo NMF algorithms}{ This interface is implemented for NMF algorithms by the classes \code{\link{NMFfit}}, \code{\link{NMFfitX}} and \code{\link{NMFStrategy}}, and their respective sub-classes. The examples given in this documentation page are mainly based on this implementation. } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } #---------- # modelname,ANY-method #---------- # get the type of an NMF model modelname(nmfModel(3)) modelname(nmfModel(3, model='NMFns')) modelname(nmfModel(3, model='NMFOffset')) #---------- # modelname,NMFStrategy-method #---------- # get the type of model(s) associated with an NMF algorithm modelname( nmfAlgorithm('brunet') ) modelname( nmfAlgorithm('nsNMF') ) modelname( nmfAlgorithm('offset') ) } \keyword{methods} NMF/man/runtime-commaNMFList-method.Rd0000644000176000001440000000150512234465004017215 0ustar ripleyusers\docType{methods} \name{runtime,NMFList-method} \alias{runtime,NMFList-method} \title{Returns the CPU time required to compute all NMF fits in the list. It returns \code{NULL} if the list is empty. If no timing data are available, the sequential time is returned.} \usage{ \S4method{runtime}{NMFList}(object, all = FALSE) } \arguments{ \item{all}{logical that indicates if the CPU time of each fit should be returned (\code{TRUE}) or only the total CPU time used to compute all the fits in \code{object}.} \item{object}{an object computed using some algorithm, or that describes an algorithm itself.} } \description{ Returns the CPU time required to compute all NMF fits in the list. It returns \code{NULL} if the list is empty. If no timing data are available, the sequential time is returned. } \keyword{methods} NMF/man/show-commaNMFns-method.Rd0000644000176000001440000000044512234465004016221 0ustar ripleyusers\docType{methods} \name{show,NMFns-method} \alias{show,NMFns-method} \title{Show method for objects of class \code{NMFns}} \usage{ \S4method{show}{NMFns}(object) } \arguments{ \item{object}{Any R object} } \description{ Show method for objects of class \code{NMFns} } \keyword{methods} NMF/man/scale.NMF.Rd0000644000176000001440000000373512305630424013501 0ustar ripleyusers\name{scale.NMF} \alias{scale.NMF} \title{Rescaling NMF Models} \usage{ \method{scale}{NMF} (x, center = c("basis", "coef"), scale = 1) } \arguments{ \item{x}{an NMF object} \item{center}{either a numeric normalising vector \eqn{\delta}{delta}, or either \code{'basis'} or \code{'coef'}, which respectively correspond to using the column sums of the basis matrix or the inverse of the row sums of the coefficient matrix as a normalising vector. If numeric, \code{center} should be a single value or a vector of length the rank of the NMF model, i.e. the number of columns in the basis matrix.} \item{scale}{scaling coefficient applied to \eqn{D}, i.e. the value of \eqn{\alpha}{alpha}, or, if \code{center='coef'}, the value of \eqn{1/\alpha}{1/alpha} (see section \emph{Details}).} } \value{ an NMF object } \description{ Rescales an NMF model keeping the fitted target matrix identical. } \details{ Standard NMF models are identifiable modulo a scaling factor, meaning that the basis components and basis profiles can be rescaled without changing the fitted values: \deqn{X = W_1 H_1 = (W_1 D) (D^{-1} H_1) = W_2 H_2}{X = W H = (W D) (D^-1 H)} with \eqn{D= \alpha diag(1/\delta_1, \ldots, 1\delta_r)}{D= alpha * diag(1/delta_1, ..., 1/delta_r)} The default call \code{scale(object)} rescales the basis NMF object so that each column of the basis matrix sums up to one. } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # random 3-rank 10x5 NMF model x <- rnmf(3, 10, 5) # rescale based on basis colSums(basis(x)) colSums(basis(scale(x))) rx <- scale(x, 'basis', 10) colSums(basis(rx)) rowSums(coef(rx)) # rescale based on coef rowSums(coef(x)) rowSums(coef(scale(x, 'coef'))) rx <- scale(x, 'coef', 10) rowSums(coef(rx)) colSums(basis(rx)) # fitted target matrix is identical but the factors have been rescaled rx <- scale(x, 'basis') all.equal(fitted(x), fitted(rx)) all.equal(basis(x), basis(rx)) } NMF/man/atrack.Rd0000644000176000001440000001013412234465004013230 0ustar ripleyusers\docType{methods} \name{.atrack} \alias{adata} \alias{alength} \alias{amargin} \alias{anames} \alias{annotationTrack} \alias{atrack} \alias{.atrack} \alias{.atrack,ANY-method} \alias{.atrack,character-method} \alias{.atrack,data.frame-method} \alias{.atrack,matrix-method} \alias{.atrack-methods} \alias{is.atrack} \title{Annotation Tracks} \usage{ .atrack(object, ...) is.atrack(x) adata(x, value, ...) amargin(x, value) anames(x, default.margin) alength(x, default.margin) \S4method{.atrack}{ANY}(object, data = NULL, ...) atrack(..., order = NULL, enforceNames = FALSE, .SPECIAL = NA, .DATA = NULL, .CACHE = NULL) annotationTrack(x = list()) } \arguments{ \item{object}{an object from which is extracted annotation tracks} \item{...}{extra arguments to allow extensions and passed to the next method call. For \code{atrack}, arguments in \code{...} are concatenated into a single \code{annotationTrack} object.} \item{x}{an R object} \item{value}{replacement value for the complete annotation data list} \item{default.margin}{margin to use if no margin data is stored in the \code{x}.} \item{data}{object used to extend the annotation track within a given data context. It is typically a matrix-like object, against which annotation specifications are matched using \code{\link{match_atrack}}.} \item{order}{an integer vector that indicates the order of the annotation tracks in the result list} \item{enforceNames}{logical that indicates if missing track names should be generated as \code{X}} \item{.SPECIAL}{an optional list of functions (with no arguments) that are called to generate special annotation tracks defined by codes of the form \code{':NAME'}. e.g., the function \code{link{consensusmap}} defines special tracks \code{':basis'} and \code{':consensus'}. If \code{.SPECIAL=FALSE}, then any special tracks is discarded and a warning is thrown.} \item{.DATA}{data used to match and extend annotation specifications. It is passed to argument \code{data} of the \code{.atrack} methods, which in turn use pass it to \code{\link{match_atrack}}.} \item{.CACHE}{an \code{annotationTrack} object with which the generated annotation track should be consistent. This argument is more for internal/advanced usage and should not be used by the end-user.} } \value{ \code{atrack} returns a list, decorated with class \code{'annotationTrack'}, where each element contains the description of an annotation track. } \description{ \code{.atrack} is an S4 generic method that converts an object into an annotation track object. It provides a general and flexible annotation framework that is used by \code{\link{aheatmap}} to annotates heatmap rows and columns. \code{is.atrack} tests if an object is an \code{annotationTrack} object. \code{adata} get/sets the annotation parameters on an object \code{amargin} get/sets the annotation margin, i.e. along which dimension of the data the annotations are to be considered. \code{anames} returns the reference margin names for annotation tracks, from their embedded annotation data object. \code{alength} returns the reference length for annotation tracks, from their embedded annotation data object \code{atrack} creates/concatenates \code{annotationTrack} objects \code{annotationTrack} is constructor function for \code{annotationTrack} object } \details{ Methods for \code{.atrack} exist for common type of objects, which should provide enough options for new methods to define how annotation track are extracted from more complex objects, by coercing/filtering them into a supported type. } \section{Methods}{ \describe{ \item{.atrack}{\code{signature(object = "ANY")}: The default method converts character or integer vectors into factors. Numeric vectors, factors, a single NA or \code{annotationTrack} objects are returned unchanged (except from reordering by argument \code{order}). Data frames are not changed either, but class 'annotationTrack' is appended to their original class set. } } } \keyword{internal} \keyword{methods} NMF/man/grid.Rd0000644000176000001440000000230112305630424012704 0ustar ripleyusers\name{tryViewport} \alias{current.vpPath_patched} \alias{tryViewport} \alias{.use.grid.patch} \title{Internal Grid Extension} \usage{ tryViewport(name, verbose = FALSE) current.vpPath_patched() .use.grid.patch() } \arguments{ \item{name}{viewport name} \item{verbose}{toggle verbosity} } \description{ These functions enable mixing base and grid graphics in \code{\link{aheatmap}}, by avoiding calls to the grid internal function \code{'L_gridDirty'}. They are not exported (i.e. not tampering core functions) and are only meant for internal use within the \pkg{NMF} package. \code{tryViewport} tries to go down to a viewport in the current tree, given its name. \code{current.vpPath_patched} aims at substituting \code{\link[grid]{current.vpPath}}, so that the graphic engine is not reset. This is essentially to prevent outputting a blank page at the beginning of PDF graphic engines. \code{.use.grid.patch} tells if the user enabled patching grid. } \details{ \code{tryViewport} uses \code{\link[grid]{grid.ls}} and not \code{\link{seekViewport}} as the latter would reset the graphic device and break the mix grid/base graphic capability. } \keyword{internal} NMF/man/foreach.Rd0000644000176000001440000001155612305630424013402 0ustar ripleyusers\docType{methods} \name{registerDoBackend} \alias{ForeachBackend} \alias{ForeachBackend,ANY-method} \alias{ForeachBackend,character-method} \alias{ForeachBackend,cluster-method} \alias{ForeachBackend,doMPI_backend-method} \alias{ForeachBackend,doParallel_backend-method} \alias{ForeachBackend,doParallelMC_backend-method} \alias{ForeachBackend,doParallelSNOW_backend-method} \alias{ForeachBackend,doPSOCK_backend-method} \alias{ForeachBackend-methods} \alias{ForeachBackend,missing-method} \alias{ForeachBackend,mpicluster-method} \alias{ForeachBackend,NULL-method} \alias{ForeachBackend,numeric-method} \alias{getDoBackend} \alias{getDoParHosts} \alias{getDoParHosts,ANY-method} \alias{getDoParHosts-methods} \alias{getDoParNHosts} \alias{register} \alias{registerDoBackend} \alias{setDoBackend} \title{Utilities and Extensions for Foreach Loops} \usage{ registerDoBackend(object, ...) getDoBackend() setDoBackend(data, cleanup = FALSE) register(x, ...) ForeachBackend(object, ...) \S4method{ForeachBackend}{doParallel_backend}(object, cl, type = NULL) \S4method{ForeachBackend}{doPSOCK_backend}(object, cl) \S4method{ForeachBackend}{doMPI_backend}(object, cl) getDoParHosts(object, ...) getDoParNHosts(object) } \arguments{ \item{object}{specification of a foreach backend, e.g. \sQuote{SEQ}, \sQuote{PAR} (for doParallel), \sQuote{MPI}, etc\ldots} \item{...}{extra arguments passed to the backend own registration function.} \item{data}{internal data of a foreach \%dopar\% backend.} \item{cleanup}{logical that indicates if the previous backend's cleanup procedure should be run, \strong{before} setting the new backend.} \item{x}{specification of a foreach backend} \item{cl}{cluster specification: a cluster object or a numeric that indicates the number of nodes to use.} \item{type}{type of cluster, See \code{\link[parallel]{makeCluster}}.} } \description{ \code{registerDoBackend} is a unified register function for foreach backends. \code{getDoBackend} returns the internal data of the currently registered foreach \%dopar\% backend. \code{setDoBackend} is identical to \code{\link[foreach]{setDoPar}}, but returns the internal of the previously registered backend. \code{register} is a generic function that register objects. It is used to as a unified interface to register foreach backends. \code{ForeachBackend} is a factory method for foreach backend objects. \code{getDoParHosts} is a generic function that returns the hostname of the worker nodes used by a backend. \code{getDoParNHosts} returns the number of hosts used by a backend. } \section{Methods}{ \describe{ \item{ForeachBackend}{\code{signature(object = "ANY")}: Default method defined to throw an informative error message, when no other method was found. } \item{ForeachBackend}{\code{signature(object = "character")}: Creates a foreach backend object based on its name. } \item{ForeachBackend}{\code{signature(object = "missing")}: Creates a foreach backend object for the currently registered backend. } \item{ForeachBackend}{\code{signature(object = "NULL")}: Dummy method that returns \code{NULL}, defined for correct dispatch. } \item{ForeachBackend}{\code{signature(object = "cluster")}: Creates a doParallel foreach backend that uses the cluster described in \code{object}. } \item{ForeachBackend}{\code{signature(object = "numeric")}: Creates a doParallel foreach backend with \code{object} processes. } \item{ForeachBackend}{\code{signature(object = "doParallel_backend")}: doParallel-specific backend factory } \item{ForeachBackend}{\code{signature(object = "doParallelMC_backend")}: doParallel-specific backend factory for multicore (fork) clusters This method is needed since version 1.0.7 of \pkg{doParallel}, which removed internal function \code{info} and defined separate backend names for mc and snow clusters. } \item{ForeachBackend}{\code{signature(object = "doParallelSNOW_backend")}: doParallel-specific backend factory for SNOW clusters. This method is needed since version 1.0.7 of \pkg{doParallel}, which removed internal function \code{info} and defined separate backend names for mc and snow clusters. } \item{ForeachBackend}{\code{signature(object = "doPSOCK_backend")}: doSNOW-specific backend factory } \item{ForeachBackend}{\code{signature(object = "mpicluster")}: Creates a doMPI foreach backend that uses the MPI cluster described in \code{object}. } \item{ForeachBackend}{\code{signature(object = "doMPI_backend")}: doMPI-specific backend factory } \item{getDoParHosts}{\code{signature(object = "ANY")}: Default method that tries to heuristaically infer the number of hosts and in last resort temporarly register the backend and performs a foreach loop, to retrieve the nodename from each worker. } } } \keyword{internal} \keyword{methods} NMF/man/fitted.Rd0000644000176000001440000000721712305630424013251 0ustar ripleyusers\docType{methods} \name{fitted} \alias{fitted} \alias{fitted-methods} \alias{fitted,NMFfit-method} \alias{fitted,NMF-method} \alias{fitted,NMFns-method} \alias{fitted,NMFOffset-method} \alias{fitted,NMFstd-method} \title{Fitted Matrix in NMF Models} \usage{ fitted(object, ...) \S4method{fitted}{NMFstd}(object, W, H, ...) \S4method{fitted}{NMFOffset}(object, W, H, offset = object@offset) \S4method{fitted}{NMFns}(object, W, H, S, ...) } \arguments{ \item{object}{an object that inherit from class \code{NMF}} \item{...}{extra arguments to allow extension} \item{W}{a matrix to use in the computation as the basis matrix in place of \code{basis(object)}. It must be compatible with the coefficient matrix used in the computation (i.e. number of columns in \code{W} = number of rows in \code{H}).} \item{H}{a matrix to use in the computation as the coefficient matrix in place of \code{coef(object)}. It must be compatible with the basis matrix used in the computation (i.e. number of rows in \code{H} = number of columns in \code{W}).} \item{offset}{offset vector} \item{S}{smoothing matrix to use instead of \code{smoothing(object)} It must be a square matrix compatible with the basis and coefficient matrices used in the computation.} } \value{ the target matrix estimate as fitted by the model \code{object} } \description{ Computes the estimated target matrix based on a given \emph{NMF} model. The estimation depends on the underlying NMF model. For example in the standard model \eqn{V \equiv W H}{V ~ W H}, the target matrix is estimated by the matrix product \eqn{W H}. In other models, the estimate may depend on extra parameters/matrix (cf. Non-smooth NMF in \code{\link{NMFns-class}}). } \details{ This function is a S4 generic function imported from \link[stats]{fitted} in the package \emph{stats}. It is implemented as a pure virtual method for objects of class \code{NMF}, meaning that concrete NMF models must provide a definition for their corresponding class (i.e. sub-classes of class \code{NMF}). See \code{\linkS4class{NMF}} for more details. } \section{Methods}{ \describe{ \item{fitted}{\code{signature(object = "NMF")}: Pure virtual method for objects of class \code{\linkS4class{NMF}}, that should be overloaded by sub-classes, and throws an error if called. } \item{fitted}{\code{signature(object = "NMFstd")}: Compute the target matrix estimate in \emph{standard NMF models}. The estimate matrix is computed as the product of the two matrix slots \code{W} and \code{H}: \deqn{\hat{V} = W H}{V ~ W H} } \item{fitted}{\code{signature(object = "NMFOffset")}: Computes the target matrix estimate for an NMFOffset object. The estimate is computed as: \deqn{ W H + offset } } \item{fitted}{\code{signature(object = "NMFns")}: Compute estimate for an NMFns object, according to the Nonsmooth NMF model (cf. \code{\link{NMFns-class}}). Extra arguments in \code{...} are passed to method \code{smoothing}, and are typically used to pass a value for \code{theta}, which is used to compute the smoothing matrix instead of the one stored in \code{object}. } \item{fitted}{\code{signature(object = "NMFfit")}: Computes and return the estimated target matrix from an NMF model fitted with function \code{\link{nmf}}. It is a shortcut for \code{fitted(fit(object), ...)}, dispatching the call to the \code{fitted} method of the actual NMF model. } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # random standard NMF model x <- rnmf(3, 10, 5) all.equal(fitted(x), basis(x) \%*\% coef(x)) } \keyword{methods} NMF/man/gfile.Rd0000644000176000001440000000031312234465004013047 0ustar ripleyusers\name{gfile} \alias{gfile} \title{Open a File Graphic Device} \usage{ gfile(filename, width, height, ...) } \description{ Opens a graphic device depending on the file extension } \keyword{internal} NMF/man/canFit.Rd0000644000176000001440000000255012234465004013172 0ustar ripleyusers\docType{methods} \name{canFit} \alias{canFit} \alias{canFit,character,ANY-method} \alias{canFit-methods} \alias{canFit,NMFStrategy,character-method} \alias{canFit,NMFStrategy,NMF-method} \title{Testing Compatibility of Algorithm and Models} \usage{ canFit(x, y, ...) \S4method{canFit}{NMFStrategy,character}(x, y, exact = FALSE) } \arguments{ \item{x}{an object that describes an algorithm} \item{y}{an object that describes a model} \item{...}{extra arguments to allow extension} \item{exact}{for logical that indicates if an algorithm is considered able to fit only the models that it explicitly declares (\code{TRUE}), or if it should be considered able to also fit models that extend models that it explicitly fits.} } \description{ \code{canFit} is an S4 generic that tests if an algorithm can fit a particular model. } \section{Methods}{ \describe{ \item{canFit}{\code{signature(x = "NMFStrategy", y = "character")}: Tells if an NMF algorithm can fit a given class of NMF models } \item{canFit}{\code{signature(x = "NMFStrategy", y = "NMF")}: Tells if an NMF algorithm can fit the same class of models as \code{y} } \item{canFit}{\code{signature(x = "character", y = "ANY")}: Tells if a registered NMF algorithm can fit a given NMF model } } } \seealso{ Other regalgo: \code{\link{nmfAlgorithm}} } \keyword{methods} NMF/man/ccRamp.Rd0000644000176000001440000000033012234465004013165 0ustar ripleyusers\name{ccRamp} \alias{ccRamp} \title{Builds a Color Ramp from Compact Color Specification} \usage{ ccRamp(x, n = NA, ...) } \description{ Builds a Color Ramp from Compact Color Specification } \keyword{internal} NMF/man/terms.Rd0000644000176000001440000000665412234465004013131 0ustar ripleyusers\docType{methods} \name{ibterms} \alias{bterms} \alias{cterms} \alias{ibasis} \alias{ibterms} \alias{ibterms-methods} \alias{ibterms,NMFfit-method} \alias{ibterms,NMFfitX-method} \alias{ibterms,NMF-method} \alias{ibterms,NMFstd-method} \alias{icoef} \alias{icterms} \alias{icterms-methods} \alias{icterms,NMFfit-method} \alias{icterms,NMF-method} \alias{icterms,NMFstd-method} \alias{iterms} \alias{nbterms} \alias{ncterms} \alias{nterms} \title{Fixed Terms in NMF Models} \usage{ ibterms(object, ...) icterms(object, ...) iterms(object, ...) nterms(object) nbterms(object) ncterms(object) bterms(object) cterms(object) ibasis(object, ...) icoef(object, ...) } \arguments{ \item{object}{NMF object} \item{...}{extra parameters to allow extension (currently not used)} } \description{ Formula-based NMF models may contain fixed basis and/or coefficient terms. The functions documented here provide access to these data, which are read-only and defined when the model object is instantiated (e.g., see \code{\link[=nmfModel,formula,ANY-method]{nmfModel,formula-method}}). \code{ibterms}, \code{icterms} and \code{iterms} respectively return the indexes of the fixed basis terms, the fixed coefficient terms and all fixed terms, within the basis and/or coefficient matrix of an NMF model. \code{nterms}, \code{nbterms}, and \code{ncterms} return, respectively, the number of all fixed terms, fixed basis terms and fixed coefficient terms in an NMF model. In particular: i.e. \code{nterms(object) = nbterms(object) + ncterms(object)}. \code{bterms} and \code{cterms} return, respectively, the primary data for fixed basis and coefficient terms in an NMF model -- as stored in slots \code{bterms} and \code{cterms} . These are factors or numeric vectors which define fixed basis components, e.g., used for defining separate offsets for different \emph{a priori} groups of samples, or to incorporate/correct for some known covariate. \code{ibasis} and \code{icoef} return, respectively, the indexes of all latent basis vectors and estimated coefficients within the basis or coefficient matrix of an NMF model. } \section{Methods}{ \describe{ \item{ibterms}{\code{signature(object = "NMF")}: Default pure virtual method that ensure a method is defined for concrete NMF model classes. } \item{ibterms}{\code{signature(object = "NMFstd")}: Method for standard NMF models, which returns the integer vector that is stored in slot \code{ibterms} when a formula-based NMF model is instantiated. } \item{ibterms}{\code{signature(object = "NMFfit")}: Method for single NMF fit objects, which returns the indexes of fixed basis terms from the fitted model. } \item{ibterms}{\code{signature(object = "NMFfitX")}: Method for multiple NMF fit objects, which returns the indexes of fixed basis terms from the best fitted model. } \item{icterms}{\code{signature(object = "NMF")}: Default pure virtual method that ensure a method is defined for concrete NMF model classes. } \item{icterms}{\code{signature(object = "NMFstd")}: Method for standard NMF models, which returns the integer vector that is stored in slot \code{icterms} when a formula-based NMF model is instantiated. } \item{icterms}{\code{signature(object = "NMFfit")}: Method for single NMF fit objects, which returns the indexes of fixed coefficient terms from the fitted model. } } } \keyword{methods} NMF/man/dispersion.Rd0000644000176000001440000000353112234465004014145 0ustar ripleyusers\docType{methods} \name{dispersion} \alias{dispersion} \alias{dispersion,matrix-method} \alias{dispersion-methods} \alias{dispersion,NMFfitX-method} \title{Dispersion of a Matrix} \usage{ dispersion(object, ...) } \arguments{ \item{object}{an object from which the dispersion is computed} \item{...}{extra arguments to allow extension} } \description{ Computes the dispersion coefficient of a -- consensus -- matrix \code{object}, generally obtained from multiple NMF runs. } \details{ The dispersion coefficient is based on the consensus matrix (i.e. the average of connectivity matrices) and was proposed by \cite{Kim et al. (2007)} to measure the reproducibility of the clusters obtained from NMF. It is defined as: \deqn{\rho = \sum_{i,j=1}^n 4 (C_{ij} - \frac{1}{2})^2 , } where \eqn{n} is the total number of samples. By construction, \eqn{0 \leq \rho \leq 1} and \eqn{\rho = 1} only for a perfect consensus matrix, where all entries 0 or 1. A perfect consensus matrix is obtained only when all the connectivity matrices are the same, meaning that the algorithm gave the same clusters at each run. See \cite{Kim et al. (2007)}. } \section{Methods}{ \describe{ \item{dispersion}{\code{signature(object = "matrix")}: Workhorse method that computes the dispersion on a given matrix. } \item{dispersion}{\code{signature(object = "NMFfitX")}: Computes the dispersion on the consensus matrix obtained from multiple NMF runs. } } } \references{ Kim H and Park H (2007). "Sparse non-negative matrix factorizations via alternating non-negativity-constrained least squares for microarray data analysis." _Bioinformatics (Oxford, England)_, *23*(12), pp. 1495-502. ISSN 1460-2059, , . } \keyword{methods} NMF/man/consensushc.Rd0000644000176000001440000000335412234465004014324 0ustar ripleyusers\docType{methods} \name{consensushc} \alias{consensushc} \alias{consensushc,matrix-method} \alias{consensushc-methods} \alias{consensushc,NMFfitX-method} \alias{consensushc,NMF-method} \title{Hierarchical Clustering of a Consensus Matrix} \usage{ consensushc(object, ...) \S4method{consensushc}{matrix}(object, method = "average", dendrogram = TRUE) \S4method{consensushc}{NMFfitX}(object, what = c("consensus", "fit"), ...) } \arguments{ \item{object}{a matrix or an \code{NMFfitX} object, as returned by multiple NMF runs.} \item{...}{extra arguments passed to next method calls} \item{method}{linkage method passed to \code{\link{hclust}}.} \item{dendrogram}{a logical that specifies if the result of the hierarchical clustering (en \code{hclust} object) should be converted into a dendrogram. Default value is \code{TRUE}.} \item{what}{character string that indicates which matrix to use in the computation.} } \value{ an object of class \code{dendrogram} or \code{hclust} depending on the value of argument \code{dendrogram}. } \description{ The function \code{consensushc} computes the hierarchical clustering of a consensus matrix, using the matrix itself as a similarity matrix and average linkage. It is } \section{Methods}{ \describe{ \item{consensushc}{\code{signature(object = "matrix")}: Workhorse method for matrices. } \item{consensushc}{\code{signature(object = "NMF")}: Compute the hierarchical clustering on the connectivity matrix of \code{object}. } \item{consensushc}{\code{signature(object = "NMFfitX")}: Compute the hierarchical clustering on the consensus matrix of \code{object}, or on the connectivity matrix of the best fit in \code{object}. } } } \keyword{methods} NMF/man/match_atrack.Rd0000644000176000001440000000056512234465004014413 0ustar ripleyusers\name{match_atrack} \alias{match_atrack} \title{Extending Annotation Vectors} \usage{ match_atrack(x, data = NULL) } \arguments{ \item{x}{annotation vector} \item{data}{reference data} } \value{ a vector of the same type as \code{x} } \description{ Extends a vector used as an annotation track to match the number of rows and the row names of a given data. } NMF/man/show-commaNMFfitX1-method.Rd0000644000176000001440000000046412234465004016575 0ustar ripleyusers\docType{methods} \name{show,NMFfitX1-method} \alias{show,NMFfitX1-method} \title{Show method for objects of class \code{NMFfitX1}} \usage{ \S4method{show}{NMFfitX1}(object) } \arguments{ \item{object}{Any R object} } \description{ Show method for objects of class \code{NMFfitX1} } \keyword{methods} NMF/man/dimnames.Rd0000644000176000001440000001154412305630424013565 0ustar ripleyusers\docType{methods} \name{basisnames} \alias{basisnames} \alias{basisnames<-} \alias{basisnames<-,ANY-method} \alias{basisnames,ANY-method} \alias{basisnames<--methods} \alias{basisnames-methods} \alias{dimnames-NMF} \alias{dimnames<-,NMF-method} \alias{dimnames,NMF-method} \title{Dimension names for NMF objects} \usage{ basisnames(x, ...) basisnames(x, ...)<-value \S4method{dimnames}{NMF}(x) \S4method{dimnames}{NMF}(x)<-value } \arguments{ \item{x}{an object with suitable \code{basis} and \code{coef} methods, such as an object that inherit from \code{\linkS4class{NMF}}.} \item{...}{extra argument to allow extension.} \item{value}{a character vector, or \code{NULL} or, in the case of \code{dimnames<-}, a list 2 or 3-length list of character vectors.} } \description{ The methods \code{dimnames}, \code{rownames}, \code{colnames} and \code{basisnames} and their respective replacement form allow to get and set the dimension names of the matrix factors in a NMF model. \code{dimnames} returns all the dimension names in a single list. Its replacement form \code{dimnames<-} allows to set all dimension names at once. \code{rownames}, \code{colnames} and \code{basisnames} provide separate access to each of these dimension names respectively. Their respective replacement form allow to set each dimension names separately. } \details{ The function \code{basisnames} is a new S4 generic defined in the package NMF, that returns the names of the basis components of an object. Its default method should work for any object, that has a suitable \code{basis} method defined for its class. The method \code{dimnames} is implemented for the base generic \code{\link{dimnames}}, which make the base function \code{\link{rownames}} and \code{\link{colnames}} work directly. Overall, these methods behave as their equivalent on \code{matrix} objects. The function \code{basisnames<-} ensures that the dimension names are handled in a consistent way on both factors, enforcing the names on both matrix factors simultaneously. The function \code{basisnames<-} is a new S4 generic defined in the package NMF, that sets the names of the basis components of an object. Its default method should work for any object, that has suitable \code{basis<-} and \code{coef<-} methods method defined for its class. } \section{Methods}{ \describe{ \item{basisnames}{\code{signature(x = "ANY")}: Default method which returns the column names of the basis matrix extracted from \code{x}, using the \code{basis} method. For NMF objects these also correspond to the row names of the coefficient matrix. } \item{basisnames<-}{\code{signature(x = "ANY")}: Default method which sets, respectively, the row and the column names of the basis matrix and coefficient matrix of \code{x} to \code{value}. } \item{dimnames}{\code{signature(x = "NMF")}: Returns the dimension names of the NMF model \code{x}. It returns either NULL if no dimnames are set on the object, or a 3-length list containing the row names of the basis matrix, the column names of the mixture coefficient matrix, and the column names of the basis matrix (i.e. the names of the basis components). } \item{dimnames<-}{\code{signature(x = "NMF")}: sets the dimension names of the NMF model \code{x}. \code{value} can be \code{NULL} which resets all dimension names, or a 1, 2 or 3-length list providing names at least for the rows of the basis matrix. The optional second element of \code{value} (NULL if absent) is used to set the column names of the coefficient matrix. The optional third element of \code{value} (NULL if absent) is used to set both the column names of the basis matrix and the row names of the coefficient matrix. } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # create a random NMF object a <- rnmf(2, 5, 3) # set dimensions dims <- list( features=paste('f', 1:nrow(a), sep='') , samples=paste('s', 1:ncol(a), sep='') , basis=paste('b', 1:nbasis(a), sep='') ) dimnames(a) <- dims dimnames(a) basis(a) coef(a) # access the dimensions separately rownames(a) colnames(a) basisnames(a) # set only the first dimension (rows of basis): the other two dimnames are set to NULL dimnames(a) <- dims[1] dimnames(a) basis(a) coef(a) # set only the two first dimensions (rows and columns of basis and coef respectively): # the basisnames are set to NULL dimnames(a) <- dims[1:2] dimnames(a) basis(a) # reset the dimensions dimnames(a) <- NULL dimnames(a) basis(a) coef(a) # set each dimensions separately rownames(a) <- paste('X', 1:nrow(a), sep='') # only affect rows of basis basis(a) colnames(a) <- paste('Y', 1:ncol(a), sep='') # only affect columns of coef coef(a) basisnames(a) <- paste('Z', 1:nbasis(a), sep='') # affect both basis and coef matrices basis(a) coef(a) } \keyword{methods} NMF/man/registry-algorithm.Rd0000644000176000001440000000326312234465004015624 0ustar ripleyusers\name{methods-NMF} \alias{existsNMFMethod} \alias{getNMFMethod} \alias{methods-NMF} \alias{removeNMFMethod} \alias{selectNMFMethod} \title{Registry for NMF Algorithms} \usage{ selectNMFMethod(name, model, load = FALSE, exact = FALSE, all = FALSE, quiet = FALSE) getNMFMethod(...) existsNMFMethod(name, exact = TRUE) removeNMFMethod(name, ...) } \arguments{ \item{name}{name of a registered NMF algorithm} \item{model}{class name of an NMF model, i.e. a class that inherits from class \code{\linkS4class{NMF}}.} \item{load}{a logical that indicates if the selected algorithms should be loaded into \code{NMFStrategy} objects} \item{all}{a logical that indicates if all algorithms that can fit \code{model} should be returned or only the default or first found.} \item{quiet}{a logical that indicates if the operation should be performed quietly, without throwing errors or warnings.} \item{...}{extra arguments passed to \code{\link[pkgmaker]{pkgreg_fetch}} or \code{\link[pkgmaker]{pkgreg_remove}}.} \item{exact}{a logical that indicates if the access key should be matched exactly (\code{TRUE}) or partially (\code{FALSE}).} } \value{ \code{selectNMFMethod} returns a character vector or \code{NMFStrategy} objects, or NULL if no suitable algorithm was found. } \description{ Registry for NMF Algorithms \code{selectNMFMethod} tries to select an appropriate NMF algorithm that is able to fit a given the NMF model. \code{getNMFMethod} retrieves NMF algorithm objects from the registry. \code{existsNMFMethod} tells if an NMF algorithm is registered under the \code{removeNMFMethod} removes an NMF algorithm from the registry. } NMF/man/NMFfit-class.Rd0000644000176000001440000002651312305630424014220 0ustar ripleyusers\docType{class} \name{NMFfit-class} \alias{NMFfit} \alias{NMFfit-class} \title{Base Class for to store Nonnegative Matrix Factorisation results} \usage{ NMFfit(fit = nmfModel(), ..., rng = NULL) } \arguments{ \item{fit}{an NMF model} \item{...}{extra argument used to initialise slots in the instantiating \code{NMFfit} object.} \item{rng}{RNG settings specification (typically a suitable value for \code{\link{.Random.seed}}).} } \description{ Base class to handle the results of general \strong{Nonnegative Matrix Factorisation} algorithms (NMF). The function \code{NMFfit} is a factory method for NMFfit objects, that should not need to be called by the user. It is used internally by the functions \code{\link{nmf}} and \code{seed} to instantiate the starting point of NMF algorithms. } \details{ It provides a general structure and generic functions to manage the results of NMF algorithms. It contains a slot with the fitted NMF model (see slot \code{fit}) as well as data about the methods and parameters used to compute the factorization. The purpose of this class is to handle in a generic way the results of NMF algorithms. Its slot \code{fit} contains the fitted NMF model as an object of class \code{\linkS4class{NMF}}. Other slots contains data about how the factorization has been computed, such as the algorithm and seeding method, the computation time, the final residuals, etc\dots{} Class \code{NMFfit} acts as a wrapper class for its slot \code{fit}. It inherits from interface class \code{\linkS4class{NMF}} defined for generic NMF models. Therefore, all the methods defined by this interface can be called directly on objects of class \code{NMFfit}. The calls are simply dispatched on slot \code{fit}, i.e. the results are the same as if calling the methods directly on slot \code{fit}. } \section{Slots}{ \describe{ \item{fit}{An object that inherits from class \code{\linkS4class{NMF}}, and contains the fitted NMF model. NB: class \code{NMF} is a virtual class. The default class for this slot is \code{NMFstd}, that implements the standard NMF model.} \item{residuals}{A \code{numeric} vector that contains the final residuals or the residuals track between the target matrix and its NMF estimate(s). Default value is \code{numeric()}. See method \code{\link{residuals}} for details on accessor methods and main interface \code{\link{nmf}} for details on how to compute NMF with residuals tracking.} \item{method}{a single \code{character} string that contains the name of the algorithm used to fit the model. Default value is \code{''}.} \item{seed}{a single \code{character} string that contains the name of the seeding method used to seed the algorithm that fitted the NMF model. Default value is \code{''}. See \code{\link{nmf}} for more details.} \item{rng}{an object that contains the RNG settings used for the fit. Currently the settings are stored as an integer vector, the value of \code{\link{.Random.seed}} at the time the object is created. It is initialized by the \code{initialized} method. See \code{\link{getRNG}} for more details.} \item{distance}{either a single \code{"character"} string that contains the name of the built-in objective function, or a \code{function} that measures the residuals between the target matrix and its NMF estimate. See \code{\link{objective}} and \code{\link{deviance,NMF-method}}.} \item{parameters}{a \code{list} that contains the extra parameters -- usually specific to the algorithm -- that were used to fit the model.} \item{runtime}{object of class \code{"proc_time"} that contains various measures of the time spent to fit the model. See \code{\link[base]{system.time}}} \item{options}{a \code{list} that contains the options used to compute the object.} \item{extra}{a \code{list} that contains extra miscellaneous data for internal usage only. For example it can be used to store extra parameters or temporary data, without the need to explicitly extend the \code{NMFfit} class. Currently built-in algorithms only use this slot to store the number of iterations performed to fit the object. Data that need to be easily accessible by the end-user should rather be set using the methods \code{$<-} that sets elements in the \code{list} slot \code{misc} -- that is inherited from class \code{\linkS4class{NMF}}.} \item{call}{stored call to the last \code{nmf} method that generated the object.} } } \section{Methods}{ \describe{ \item{algorithm}{\code{signature(object = "NMFfit")}: Returns the name of the algorithm that fitted the NMF model \code{object}. } \item{.basis}{\code{signature(object = "NMFfit")}: Returns the basis matrix from an NMF model fitted with function \code{\link{nmf}}. It is a shortcut for \code{.basis(fit(object), ...)}, dispatching the call to the \code{.basis} method of the actual NMF model. } \item{.basis<-}{\code{signature(object = "NMFfit", value = "matrix")}: Sets the the basis matrix of an NMF model fitted with function \code{\link{nmf}}. It is a shortcut for \code{.basis(fit(object)) <- value}, dispatching the call to the \code{.basis<-} method of the actual NMF model. It is not meant to be used by the user, except when developing NMF algorithms, to update the basis matrix of the seed object before returning it. } \item{.coef}{\code{signature(object = "NMFfit")}: Returns the the coefficient matrix from an NMF model fitted with function \code{\link{nmf}}. It is a shortcut for \code{.coef(fit(object), ...)}, dispatching the call to the \code{.coef} method of the actual NMF model. } \item{.coef<-}{\code{signature(object = "NMFfit", value = "matrix")}: Sets the the coefficient matrix of an NMF model fitted with function \code{\link{nmf}}. It is a shortcut for \code{.coef(fit(object)) <- value}, dispatching the call to the \code{.coef<-} method of the actual NMF model. It is not meant to be used by the user, except when developing NMF algorithms, to update the coefficient matrix in the seed object before returning it. } \item{compare}{\code{signature(object = "NMFfit")}: Compare multiple NMF fits passed as arguments. } \item{deviance}{\code{signature(object = "NMFfit")}: Returns the deviance of a fitted NMF model. This method returns the final residual value if the target matrix \code{y} is not supplied, or the approximation error between the fitted NMF model stored in \code{object} and \code{y}. In this case, the computation is performed using the objective function \code{method} if not missing, or the objective of the algorithm that fitted the model (stored in slot \code{'distance'}). See \code{\link{deviance,NMFfit-method}} for more details. } \item{fit}{\code{signature(object = "NMFfit")}: Returns the NMF model object stored in slot \code{'fit'}. } \item{fit<-}{\code{signature(object = "NMFfit", value = "NMF")}: Updates the NMF model object stored in slot \code{'fit'} with a new value. } \item{fitted}{\code{signature(object = "NMFfit")}: Computes and return the estimated target matrix from an NMF model fitted with function \code{\link{nmf}}. It is a shortcut for \code{fitted(fit(object), ...)}, dispatching the call to the \code{fitted} method of the actual NMF model. } \item{ibterms}{\code{signature(object = "NMFfit")}: Method for single NMF fit objects, which returns the indexes of fixed basis terms from the fitted model. } \item{icterms}{\code{signature(object = "NMFfit")}: Method for single NMF fit objects, which returns the indexes of fixed coefficient terms from the fitted model. } \item{icterms}{\code{signature(object = "NMFfit")}: Method for multiple NMF fit objects, which returns the indexes of fixed coefficient terms from the best fitted model. } \item{minfit}{\code{signature(object = "NMFfit")}: Returns the object its self, since there it is the result of a single NMF run. } \item{modelname}{\code{signature(object = "NMFfit")}: Returns the type of a fitted NMF model. It is a shortcut for \code{modelname(fit(object)}. } \item{niter}{\code{signature(object = "NMFfit")}: Returns the number of iteration performed to fit an NMF model, typically with function \code{\link{nmf}}. Currently this data is stored in slot \code{'extra'}, but this might change in the future. } \item{niter<-}{\code{signature(object = "NMFfit", value = "numeric")}: Sets the number of iteration performed to fit an NMF model. This function is used internally by the function \code{\link{nmf}}. It is not meant to be called by the user, except when developing new NMF algorithms implemented as single function, to set the number of iterations performed by the algorithm on the seed, before returning it (see \code{\linkS4class{NMFStrategyFunction}}). } \item{nmf.equal}{\code{signature(x = "NMFfit", y = "NMF")}: Compares two NMF models when at least one comes from a NMFfit object, i.e. an object returned by a single run of \code{\link{nmf}}. } \item{nmf.equal}{\code{signature(x = "NMFfit", y = "NMFfit")}: Compares two fitted NMF models, i.e. objects returned by single runs of \code{\link{nmf}}. } \item{NMFfitX}{\code{signature(object = "NMFfit")}: Creates an \code{NMFfitX1} object from a single fit. This is used in \code{\link{nmf}} when only the best fit is kept in memory or on disk. } \item{nrun}{\code{signature(object = "NMFfit")}: This method always returns 1, since an \code{NMFfit} object is obtained from a single NMF run. } \item{objective}{\code{signature(object = "NMFfit")}: Returns the objective function associated with the algorithm that computed the fitted NMF model \code{object}, or the objective value with respect to a given target matrix \code{y} if it is supplied. } \item{offset}{\code{signature(object = "NMFfit")}: Returns the offset from the fitted model. } \item{plot}{\code{signature(x = "NMFfit", y = "missing")}: Plots the residual track computed at regular interval during the fit of the NMF model \code{x}. } \item{residuals}{\code{signature(object = "NMFfit")}: Returns the residuals -- track -- between the target matrix and the NMF fit \code{object}. } \item{runtime}{\code{signature(object = "NMFfit")}: Returns the CPU time required to compute a single NMF fit. } \item{runtime.all}{\code{signature(object = "NMFfit")}: Identical to \code{runtime}, since their is a single fit. } \item{seeding}{\code{signature(object = "NMFfit")}: Returns the name of the seeding method that generated the starting point for the NMF algorithm that fitted the NMF model \code{object}. } \item{show}{\code{signature(object = "NMFfit")}: Show method for objects of class \code{NMFfit} } \item{summary}{\code{signature(object = "NMFfit")}: Computes summary measures for a single fit from \code{\link{nmf}}. This method adds the following measures to the measures computed by the method \code{summary,NMF}: See \code{\link{summary,NMFfit-method}} for more details. } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # run default NMF algorithm on a random matrix n <- 50; r <- 3; p <- 20 V <- rmatrix(n, p) res <- nmf(V, r) # result class is NMFfit class(res) isNMFfit(res) # show result res # compute summary measures summary(res, target=V) } NMF/man/show-commaNMFSeed-method.Rd0000644000176000001440000000045712234465004016464 0ustar ripleyusers\docType{methods} \name{show,NMFSeed-method} \alias{show,NMFSeed-method} \title{Show method for objects of class \code{NMFSeed}} \usage{ \S4method{show}{NMFSeed}(object) } \arguments{ \item{object}{Any R object} } \description{ Show method for objects of class \code{NMFSeed} } \keyword{methods} NMF/man/setup.Rd0000644000176000001440000000476512234465004013140 0ustar ripleyusers\name{setupBackend} \alias{setupBackend} \alias{setupLibPaths} \alias{setupRNG} \alias{setupSharedMemory} \alias{setupTempDirectory} \title{Computational Setup Functions} \usage{ setupBackend(spec, backend, optional = FALSE, verbose = FALSE) setupSharedMemory(verbose) setupTempDirectory(verbose) setupLibPaths(pkg = "NMF", verbose = FALSE) setupRNG(seed, n, verbose = FALSE) } \arguments{ \item{spec}{target parallel specification: either \code{TRUE} or \code{FALSE}, or a single numeric value that specifies the number of cores to setup.} \item{backend}{value from argument \code{.pbackend} of \code{nmf}.} \item{optional}{a logical that indicates if the specification must be fully satisfied, throwing an error if it is not, or if one can switch back to sequential, only outputting a verbose message.} \item{verbose}{logical or integer level of verbosity for message outputs.} \item{pkg}{package name whose path should be exported the workers.} \item{seed}{initial RNG seed specification} \item{n}{number of RNG seeds to generate} } \value{ Returns \code{FALSE} if no foreach backend is to be used, \code{NA} if the currently registered backend is to be used, or, if this function call registered a new backend, the previously registered backend as a \code{foreach} object, so that it can be restored after the computation is over. } \description{ Functions used internally to setup the computational environment. \code{setupBackend} sets up a foreach backend given some specifications. \code{setupSharedMemory} checks if one can use the packages \emph{bigmemory} and \emph{sychronicity} to speed-up parallel computations when not keeping all the fits. When both these packages are available, only one result per host is written on disk, with its achieved deviance stored in shared memory, that is accessible to all cores on a same host. It returns \code{TRUE} if both packages are available and NMF option \code{'shared'} is toggled on. \code{setupTempDirectory} creates a temporary directory to store the best fits computed on each host. It ensures each worker process has access to it. \code{setupLibPaths} add the path to the NMF package to each workers' libPaths. \code{setupRNG} sets the RNG for use by the function nmf. It returns the old RNG as an rstream object or the result of set.seed if the RNG is not changed due to one of the following reason: - the settings are not compatible with rstream } \keyword{internals} NMF/man/show-commaNMF-method.Rd0000644000176000001440000000043312234465004015655 0ustar ripleyusers\docType{methods} \name{show,NMF-method} \alias{show,NMF-method} \title{Show method for objects of class \code{NMF}} \usage{ \S4method{show}{NMF}(object) } \arguments{ \item{object}{Any R object} } \description{ Show method for objects of class \code{NMF} } \keyword{methods} NMF/man/syntheticNMF.Rd0000644000176000001440000000623112305630424014340 0ustar ripleyusers\name{syntheticNMF} \alias{syntheticNMF} \title{Simulating Datasets} \usage{ syntheticNMF(n, r, p, offset = NULL, noise = TRUE, factors = FALSE, seed = NULL) } \arguments{ \item{n}{number of rows of the target matrix.} \item{r}{specification of the factorization rank. It may be a single \code{numeric}, in which case argument \code{p} is required and \code{r} groups of samples are generated from a draw from a multinomial distribution with equal probabilities, that provides their sizes. It may also be a numerical vector, which contains the number of samples in each class (i.e integers). In this case argument \code{p} is discarded and forced to be the sum of \code{r}.} \item{p}{number of columns of the synthetic target matrix. Not used if parameter \code{r} is a vector (see description of argument \code{r}).} \item{offset}{specification of a common offset to be added to the synthetic target matrix, before noisification. Its may be a numeric vector of length \code{n}, or a single numeric value that is used as the standard deviation of a centred normal distribution from which the actual offset values are drawn.} \item{noise}{a logical that indicate if noise should be added to the matrix.} \item{factors}{a logical that indicates if the NMF factors should be return together with the matrix.} \item{seed}{a single numeric value used to seed the random number generator before generating the matrix. The state of the RNG is restored on exit.} } \value{ a matrix, or a list if argument \code{factors=TRUE}. When \code{factors=FALSE}, the result is a matrix object, with the following attributes set: \describe{ \item{coefficients}{the true underlying coefficient matrix (i.e. \code{H});} \item{basis}{the true underlying coefficient matrix (i.e. \code{H});} \item{offset}{the offset if any;} \item{pData}{a \code{list} with one element \code{'Group'} that contains a factor that indicates the true groups of samples, i.e. the most contributing basis component for each sample;} \item{fData}{a \code{list} with one element \code{'Group'} that contains a factor that indicates the true groups of features, i.e. the basis component to which each feature contributes the most.} } Moreover, the result object is an \code{\link{ExposeAttribute}} object, which means that relevant attributes are accessible via \code{$}, e.g., \code{res$coefficients}. In particular, methods \code{\link{coef}} and \code{\link{basis}} will work as expected and return the true underlying coefficient and basis matrices respectively. } \description{ The function \code{syntheticNMF} generates random target matrices that follow some defined NMF model, and may be used to test NMF algorithms. It is designed to designed to produce data with known or clear classes of samples. } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # generate a synthetic dataset with known classes: 50 features, 18 samples (5+5+8) n <- 50 counts <- c(5, 5, 8) # no noise V <- syntheticNMF(n, counts, noise=FALSE) \dontrun{aheatmap(V)} # with noise V <- syntheticNMF(n, counts) \dontrun{aheatmap(V)} } NMF/man/nmfSeed.Rd0000644000176000001440000000464712305630424013357 0ustar ripleyusers\name{nmfSeed} \alias{existsNMFSeed} \alias{getNMFSeed} \alias{nmfSeed} \title{Seeding Strategies for NMF Algorithms} \usage{ nmfSeed(name = NULL, ...) getNMFSeed(name = NULL, ...) existsNMFSeed(name, exact = TRUE) } \arguments{ \item{name}{access key of a seeding method stored in registry. If missing, \code{nmfSeed} returns the list of all available seeding methods.} \item{...}{extra arguments used for internal calls} \item{exact}{a logical that indicates if the access key should be matched exactly or partially.} } \description{ \code{nmfSeed} lists and retrieves NMF seeding methods. \code{getNMFSeed} is an alias for \code{nmfSeed}. \code{existsNMFSeed} tells if a given seeding method exists in the registry. } \details{ 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{Boutsidis et al. (2008)}} \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.} } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # list all registered seeding methods nmfSeed() # retrieve one of the methods nmfSeed('ica') } \references{ Boutsidis C and Gallopoulos E (2008). "SVD based initialization: A head start for nonnegative matrix factorization." _Pattern Recognition_, *41*(4), pp. 1350-1362. ISSN 00313203, , . } NMF/man/objective-commaNMFfit-method.Rd0000644000176000001440000000140412234465004017351 0ustar ripleyusers\docType{methods} \name{objective,NMFfit-method} \alias{objective,NMFfit-method} \title{Returns the objective function associated with the algorithm that computed the fitted NMF model \code{object}, or the objective value with respect to a given target matrix \code{y} if it is supplied.} \usage{ \S4method{objective}{NMFfit}(object, y) } \arguments{ \item{y}{optional target matrix used to compute the objective value.} \item{object}{an object computed using some algorithm, or that describes an algorithm itself.} } \description{ Returns the objective function associated with the algorithm that computed the fitted NMF model \code{object}, or the objective value with respect to a given target matrix \code{y} if it is supplied. } \keyword{methods} NMF/man/show-commaNMFList-method.Rd0000644000176000001440000000045712234465004016517 0ustar ripleyusers\docType{methods} \name{show,NMFList-method} \alias{show,NMFList-method} \title{Show method for objects of class \code{NMFList}} \usage{ \S4method{show}{NMFList}(object) } \arguments{ \item{object}{Any R object} } \description{ Show method for objects of class \code{NMFList} } \keyword{methods} NMF/man/NMFfitX.Rd0000644000176000001440000000241712234465004013243 0ustar ripleyusers\docType{methods} \name{NMFfitX} \alias{NMFfitX} \alias{NMFfitX,list-method} \alias{NMFfitX-methods} \alias{NMFfitX,NMFfit-method} \alias{NMFfitX,NMFfitX-method} \title{Factory Method for Multiple NMF Run Objects} \usage{ NMFfitX(object, ...) \S4method{NMFfitX}{list}(object, ..., .merge = FALSE) } \arguments{ \item{object}{an object from which is created an \code{NMFfitX} object} \item{...}{extra arguments used to pass values for slots} \item{.merge}{a logical that indicates if the fits should be aggregated, only keeping the best fit, and return an \code{NMFfitX1} object. If \code{FALSE}, an \code{NMFfitXn} object containing the data of all the fits is returned.} } \description{ Factory Method for Multiple NMF Run Objects } \section{Methods}{ \describe{ \item{NMFfitX}{\code{signature(object = "list")}: Create an \code{NMFfitX} object from a list of fits. } \item{NMFfitX}{\code{signature(object = "NMFfit")}: Creates an \code{NMFfitX1} object from a single fit. This is used in \code{\link{nmf}} when only the best fit is kept in memory or on disk. } \item{NMFfitX}{\code{signature(object = "NMFfitX")}: Provides a way to aggregate \code{NMFfitXn} objects into an \code{NMFfitX1} object. } } } \keyword{internal} \keyword{methods} NMF/man/dot-fcnnls.Rd0000644000176000001440000000407312234465004014037 0ustar ripleyusers\name{.fcnnls} \alias{.fcnnls} \title{Internal Routine for Fast Combinatorial Nonnegative Least-Squares} \usage{ .fcnnls(x, y, verbose = FALSE, pseudo = FALSE, eps = 0) } \arguments{ \item{x}{the coefficient matrix} \item{y}{the target matrix to be approximated by \eqn{X K}.} \item{verbose}{logical that indicates if log messages should be shown.} \item{pseudo}{By default (\code{pseudo=FALSE}) the algorithm uses Gaussian elimination to solve the successive internal linear problems, using the \code{\link{solve}} function. If \code{pseudo=TRUE} the algorithm uses Moore-Penrose generalized \code{\link[corpcor]{pseudoinverse}} from the \code{corpcor} package instead of \link{solve}.} \item{eps}{threshold for considering entries as nonnegative. This is an experimental parameter, and it is recommended to leave it at 0.} } \value{ A list with the following elements: \item{coef}{the fitted coefficient matrix.} \item{Pset}{the set of passive constraints, as a logical matrix of the same size as \code{K} that indicates which element is positive.} } \description{ This is the workhorse function for the higher-level function \code{\link{fcnnls}}, which implements the fast nonnegative least-square algorithm for multiple right-hand-sides from \cite{Van Benthem et al. (2004)} to solve the following problem: \deqn{ \begin{array}{l} \min \|Y - X K\|_F\\ \mbox{s.t. } K>=0 \end{array} }{min ||Y - X K||_F, s.t. K>=0} where \eqn{Y} and \eqn{X} are two real matrices of dimension \eqn{n \times p}{n x p} and \eqn{n \times r}{n x r} respectively, and \eqn{\|.\|_F}{|.|_F} is the Frobenius norm. The algorithm is very fast compared to other approaches, as it is optimised for handling multiple right-hand sides. } \references{ Van Benthem M and Keenan MR (2004). "Fast algorithm for the solution of large-scale non-negativity-constrained least squares problems." _Journal of Chemometrics_, *18*(10), pp. 441-450. ISSN 0886-9383, , . } NMF/man/NMFfitX1-class.Rd0000644000176000001440000000676512305630424014440 0ustar ripleyusers\docType{class} \name{NMFfitX1-class} \alias{NMFfitX1-class} \title{Structure for Storing the Best Fit Amongst Multiple NMF Runs} \description{ This class is used to return the result from a multiple run of a single NMF algorithm performed with function \code{nmf} with the -- default -- option \code{keep.all=FALSE} (cf. \code{\link{nmf}}). } \details{ It extends both classes \code{\linkS4class{NMFfitX}} and \code{\linkS4class{NMFfit}}, and stores a the result of the best fit in its \code{NMFfit} structure. Beside the best fit, this class allows to hold data about the computation of the multiple runs, such as the number of runs, the CPU time used to perform all the runs, as well as the consensus matrix. Due to the inheritance from class \code{NMFfit}, objects of class \code{NMFfitX1} can be handled exactly as the results of single NMF run -- as if only the best run had been performed. } \section{Slots}{ \describe{ \item{consensus}{object of class \code{matrix} used to store the consensus matrix based on all the runs.} \item{nrun}{an \code{integer} that contains the number of runs performed to compute the object.} \item{rng1}{an object that contains RNG settings used for the first run. See \code{\link{getRNG1}}.} } } \section{Methods}{ \describe{ \item{consensus}{\code{signature(object = "NMFfitX1")}: The result is the matrix stored in slot \sQuote{consensus}. This method returns \code{NULL} if the consensus matrix is empty. } \item{fit}{\code{signature(object = "NMFfitX1")}: Returns the model object associated with the best fit, amongst all the runs performed when fitting \code{object}. Since \code{NMFfitX1} objects only hold the best fit, this method simply returns the NMF model fitted by \code{object} -- that is stored in slot \sQuote{fit}. } \item{getRNG1}{\code{signature(object = "NMFfitX1")}: Returns the RNG settings used to compute the first of all NMF runs, amongst which \code{object} was selected as the best fit. } \item{minfit}{\code{signature(object = "NMFfitX1")}: Returns the fit object associated with the best fit, amongst all the runs performed when fitting \code{object}. Since \code{NMFfitX1} objects only hold the best fit, this method simply returns \code{object} coerced into an \code{NMFfit} object. } \item{nmf.equal}{\code{signature(x = "NMFfitX1", y = "NMFfitX1")}: Compares the NMF models fitted by multiple runs, that only kept the best fits. } \item{nrun}{\code{signature(object = "NMFfitX1")}: Returns the number of NMF runs performed, amongst which \code{object} was selected as the best fit. } \item{show}{\code{signature(object = "NMFfitX1")}: Show method for objects of class \code{NMFfitX1} } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # generate a synthetic dataset with known classes n <- 20; counts <- c(5, 2, 3); V <- syntheticNMF(n, counts) # get the class factor groups <- V$pData$Group # perform multiple runs of one algorithm, keeping only the best fit (default) #i.e.: the implicit nmf options are .options=list(keep.all=FALSE) or .options='-k' res <- nmf(V, 3, nrun=3) res # compute summary measures summary(res) # get more info summary(res, target=V, class=groups) # show computational time runtime.all(res) # plot the consensus matrix, as stored (pre-computed) in the object \dontrun{ consensusmap(res, annCol=groups) } } \seealso{ Other multipleNMF: \code{\link{NMFfitX-class}}, \code{\link{NMFfitXn-class}} } NMF/man/RNG.Rd0000644000176000001440000000407712305630424012421 0ustar ripleyusers\docType{methods} \name{getRNG1} \alias{.getRNG} \alias{getRNG1} \alias{getRNG1-methods} \alias{getRNG1,NMFfitX1-method} \alias{getRNG1,NMFfitX-method} \alias{getRNG1,NMFfitXn-method} \alias{.getRNG-methods} \alias{.getRNG,NMFfitXn-method} \title{Extracting RNG Data from NMF Objects} \usage{ getRNG1(object, ...) .getRNG(object, ...) } \arguments{ \item{object}{an R object from which RNG settings can be extracted, e.g. an integer vector containing a suitable value for \code{.Random.seed} or embedded RNG data, e.g., in S3/S4 slot \code{rng} or \code{rng$noise}.} \item{...}{extra arguments to allow extension and passed to a suitable S4 method \code{.getRNG} or \code{.setRNG}.} } \description{ The \code{\link{nmf}} function returns objects that contain embedded RNG data, that can be used to exactly reproduce any computation. These data can be extracted using dedicated methods for the S4 generics \code{\link[rngtools]{getRNG}} and \code{\link[rngtools]{getRNG1}}. } \section{Methods}{ \describe{ \item{.getRNG}{\code{signature(object = "NMFfitXn")}: Returns the RNG settings used for the best fit. This method throws an error if the object is empty. } \item{getRNG1}{\code{signature(object = "NMFfitX")}: Returns the RNG settings used for the first NMF run of multiple NMF runs. } \item{getRNG1}{\code{signature(object = "NMFfitX1")}: Returns the RNG settings used to compute the first of all NMF runs, amongst which \code{object} was selected as the best fit. } \item{getRNG1}{\code{signature(object = "NMFfitXn")}: Returns the RNG settings used for the first run. This method throws an error if the object is empty. } } } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # For multiple NMF runs, the RNG settings used for the first run is also stored V <- rmatrix(20,10) res <- nmf(V, 3, nrun=4) # RNG used for the best fit getRNG(res) # RNG used for the first of all fits getRNG1(res) # they may differ if the best fit is not the first one rng.equal(res, getRNG1(res)) } \keyword{methods} NMF/man/NMFStrategy.Rd0000644000176000001440000001504112305630424014127 0ustar ripleyusers\docType{methods} \name{NMFStrategy} \alias{NMFStrategy} \alias{NMFStrategy,character,character-method} \alias{NMFStrategy,character,function-method} \alias{NMFStrategy,character,missing-method} \alias{NMFStrategy,character,NMFStrategy-method} \alias{NMFStrategy-methods} \alias{NMFStrategy,missing,character-method} \alias{NMFStrategy,NMFStrategy,missing-method} \alias{NMFStrategy,NULL,character-method} \alias{NMFStrategy,NULL,NMFStrategy-method} \alias{run,NMFStrategyFunction,matrix,NMFfit-method} \alias{run,NMFStrategyIterative,matrix,NMFfit-method} \alias{run,NMFStrategyIterativeX,matrix,NMFfit-method} \alias{run,NMFStrategy,matrix,NMFfit-method} \alias{run,NMFStrategy,matrix,NMF-method} \alias{run,NMFStrategyOctave,matrix,NMFfit-method} \title{Factory Method for NMFStrategy Objects} \usage{ NMFStrategy(name, method, ...) \S4method{run}{NMFStrategy,matrix,NMFfit}(object, y, x, ...) \S4method{run}{NMFStrategy,matrix,NMF}(object, y, x, ...) \S4method{run}{NMFStrategyFunction,matrix,NMFfit}(object, y, x, ...) \S4method{run}{NMFStrategyIterative,matrix,NMFfit}(object, y, x, .stop = NULL, maxIter = nmf.getOption("maxIter") \%||\% 2000, ...) \S4method{run}{NMFStrategyIterativeX,matrix,NMFfit}(object, y, x, maxIter, ...) \S4method{run}{NMFStrategyOctave,matrix,NMFfit}(object, y, x, ...) } \arguments{ \item{name}{name/key of an NMF algorithm.} \item{method}{definition of the algorithm} \item{...}{extra arguments passed to \code{\link{new}}.} \item{.stop}{specification of a stopping criterion, that is used instead of the one associated to the NMF algorithm. It may be specified as: \itemize{ \item the access key of a registered stopping criterion; \item a single integer that specifies the exact number of iterations to perform, which will be honoured unless a lower value is explicitly passed in argument \code{maxIter}. \item a single numeric value that specifies the stationnarity threshold for the objective function, used in with \code{\link{nmf.stop.stationary}}; \item a function with signature \code{(object="NMFStrategy", i="integer", y="matrix", x="NMF", ...)}, where \code{object} is the \code{NMFStrategy} object that describes the algorithm being run, \code{i} is the current iteration, \code{y} is the target matrix and \code{x} is the current value of the NMF model. }} \item{maxIter}{maximum number of iterations to perform.} \item{object}{an object computed using some algorithm, or that describes an algorithm itself.} \item{y}{data object, e.g. a target matrix} \item{x}{a model object used as a starting point by the algorithm, e.g. a non-empty NMF model.} } \description{ Creates NMFStrategy objects that wraps implementation of NMF algorithms into a unified interface. } \section{Methods}{ \describe{ \item{NMFStrategy}{\code{signature(name = "character", method = "function")}: Creates an \code{NMFStrategyFunction} object that wraps the function \code{method} into a unified interface. \code{method} must be a function with signature \code{(y="matrix", x="NMFfit", ...)}, and return an object of class \code{\linkS4class{NMFfit}}. } \item{NMFStrategy}{\code{signature(name = "character", method = "NMFStrategy")}: Creates an \code{NMFStrategy} object based on a template object (Constructor-Copy). } \item{NMFStrategy}{\code{signature(name = "NMFStrategy", method = "missing")}: Creates an \code{NMFStrategy} based on a template object (Constructor-Copy), in particular it uses the \strong{same} name. } \item{NMFStrategy}{\code{signature(name = "missing", method = "character")}: Creates an \code{NMFStrategy} based on a registered NMF algorithm that is used as a template (Constructor-Copy), in particular it uses the \strong{same} name. It is a shortcut for \code{NMFStrategy(nmfAlgorithm(method, exact=TRUE), ...)}. } \item{NMFStrategy}{\code{signature(name = "NULL", method = "NMFStrategy")}: Creates an \code{NMFStrategy} based on a template object (Constructor-Copy) but using a randomly generated name. } \item{NMFStrategy}{\code{signature(name = "character", method = "character")}: Creates an \code{NMFStrategy} based on a registered NMF algorithm that is used as a template. } \item{NMFStrategy}{\code{signature(name = "NULL", method = "character")}: Creates an \code{NMFStrategy} based on a registered NMF algorithm (Constructor-Copy) using a randomly generated name. It is a shortcut for \code{NMFStrategy(NULL, nmfAlgorithm(method), ...)}. } \item{NMFStrategy}{\code{signature(name = "character", method = "missing")}: Creates an NMFStrategy, determining its type from the extra arguments passed in \code{...}: if there is an argument named \code{Update} then an \code{NMFStrategyIterative} is created, or if there is an argument named \code{algorithm} then an \code{NMFStrategyFunction} is created. Calls other than these generates an error. } \item{run}{\code{signature(object = "NMFStrategy", y = "matrix", x = "NMFfit")}: Pure virtual method defined for all NMF algorithms to ensure that a method \code{run} is defined by sub-classes of \code{NMFStrategy}. It throws an error if called directly. } \item{run}{\code{signature(object = "NMFStrategy", y = "matrix", x = "NMF")}: Method to run an NMF algorithm directly starting from a given NMF model. } \item{run}{\code{signature(object = "NMFStrategyFunction", y = "matrix", x = "NMFfit")}: Runs the NMF algorithms implemented by the single R function -- and stored in slot \code{'algorithm'} of \code{object}, on the data object \code{y}, using \code{x} as starting point. It is equivalent to calling \code{object@algorithm(y, x, ...)}. This method is usually not called directly, but only via the function \code{\link{nmf}}, which takes care of many other details such as seeding the computation, handling RNG settings, or setting up parallelisation. } \item{run}{\code{signature(object = "NMFStrategyIterative", y = "matrix", x = "NMFfit")}: Runs an NMF iterative algorithm on a target matrix \code{y}. } \item{run}{\code{signature(object = "NMFStrategyOctave", y = "matrix", x = "NMFfit")}: Runs the NMF algorithms implemented by the Octave/Matlab function associated with the strategy -- and stored in slot \code{'algorithm'} of \code{object}. This method is usually not called directly, but only via the function \code{\link{nmf}}, which takes care of many other details such as seeding the computation, handling RNG settings, or setting up parallel computations. } } } \keyword{methods} NMF/man/Frobenius-nmf.Rd0000644000176000001440000001214312305630424014476 0ustar ripleyusers\name{nmf_update.lee_R} \alias{Frobenius-nmf} \alias{lee-nmf} \alias{lee_R-nmf} \alias{nmfAlgorithm.Frobenius} \alias{nmfAlgorithm.lee} \alias{nmfAlgorithm.lee_R} \alias{nmf_update.lee} \alias{nmf_update.lee_R} \title{NMF Algorithm/Updates for Frobenius Norm} \usage{ nmf_update.lee_R(i, v, x, rescale = TRUE, eps = 10^-9, ...) nmf_update.lee(i, v, x, rescale = TRUE, copy = FALSE, eps = 10^-9, weight = NULL, ...) nmfAlgorithm.lee_R(..., .stop = NULL, maxIter = nmf.getOption("maxIter") \%||\% 2000, rescale = TRUE, eps = 10^-9, stopconv = 40, check.interval = 10) nmfAlgorithm.lee(..., .stop = NULL, maxIter = nmf.getOption("maxIter") \%||\% 2000, rescale = TRUE, copy = FALSE, eps = 10^-9, weight = NULL, stopconv = 40, check.interval = 10) nmfAlgorithm.Frobenius(..., .stop = NULL, maxIter = nmf.getOption("maxIter") \%||\% 2000, rescale = TRUE, copy = FALSE, eps = 10^-9, weight = NULL, stationary.th = .Machine$double.eps, check.interval = 5 * check.niter, check.niter = 10L) } \arguments{ \item{rescale}{logical that indicates if the basis matrix \eqn{W} should be rescaled so that its columns sum up to one.} \item{i}{current iteration number.} \item{v}{target matrix.} \item{x}{current NMF model, as an \code{\linkS4class{NMF}} object.} \item{eps}{small numeric value used to ensure numeric stability, by shifting up entries from zero to this fixed value.} \item{...}{extra arguments. These are generally not used and present only to allow other arguments from the main call to be passed to the initialisation and stopping criterion functions (slots \code{onInit} and \code{Stop} respectively).} \item{copy}{logical that indicates if the update should be made on the original matrix directly (\code{FALSE}) or on a copy (\code{TRUE} - default). With \code{copy=FALSE} the memory footprint is very small, and some speed-up may be achieved in the case of big matrices. However, greater care should be taken due the side effect. We recommend that only experienced users use \code{copy=TRUE}.} \item{.stop}{specification of a stopping criterion, that is used instead of the one associated to the NMF algorithm. It may be specified as: \itemize{ \item the access key of a registered stopping criterion; \item a single integer that specifies the exact number of iterations to perform, which will be honoured unless a lower value is explicitly passed in argument \code{maxIter}. \item a single numeric value that specifies the stationnarity threshold for the objective function, used in with \code{\link{nmf.stop.stationary}}; \item a function with signature \code{(object="NMFStrategy", i="integer", y="matrix", x="NMF", ...)}, where \code{object} is the \code{NMFStrategy} object that describes the algorithm being run, \code{i} is the current iteration, \code{y} is the target matrix and \code{x} is the current value of the NMF model. }} \item{maxIter}{maximum number of iterations to perform.} \item{stopconv}{number of iterations intervals over which the connectivity matrix must not change for stationarity to be achieved.} \item{check.interval}{interval (in number of iterations) on which the stopping criterion is computed.} \item{stationary.th}{maximum absolute value of the gradient, for the objective function to be considered stationary.} \item{check.niter}{number of successive iteration used to compute the stationnary criterion.} \item{weight}{numeric vector of sample weights, e.g., used to normalise samples coming from multiple datasets. It must be of the same length as the number of samples/columns in \code{v} -- and \code{h}.} } \description{ The built-in NMF algorithms described here minimise the Frobenius norm (Euclidean distance) between an NMF model and a target matrix. They use the updates for the basis and coefficient matrices (\eqn{W} and \eqn{H}) defined by \cite{Lee et al. (2001)}. \code{nmf_update.lee} implements in C++ an optimised version of the single update step. Algorithms \sQuote{lee} and \sQuote{.R#lee} provide the complete NMF algorithm from \cite{Lee et al. (2001)}, using the C++-optimised and pure R updates \code{\link{nmf_update.lee}} and \code{\link{nmf_update.lee_R}} respectively. Algorithm \sQuote{Frobenius} provides an NMF algorithm based on the C++-optimised version of the updates from \cite{Lee et al. (2001)}, which uses the stationarity of the objective value as a stopping criterion \code{\link{nmf.stop.stationary}}, instead of the stationarity of the connectivity matrix \code{\link{nmf.stop.connectivity}} as used by \sQuote{lee}. } \details{ \code{nmf_update.lee_R} implements in pure R a single update step, i.e. it updates both matrices. } \author{ Original update definition: D D Lee and HS Seung Port to R and optimisation in C++: Renaud Gaujoux } \references{ Lee DD and Seung H (2001). "Algorithms for non-negative matrix factorization." _Advances in neural information processing systems_. . } NMF/man/esGolub.Rd0000644000176000001440000000530712530703420013365 0ustar ripleyusers\docType{data} \name{esGolub} \alias{esGolub} \title{Golub ExpressionSet} \format{There are 3 covariates listed. \itemize{ \item Samples: The original sample labels. \item ALL.AML: Whether the patient had AML or ALL. It is a \code{\link{factor}} with levels \code{c('ALL', 'AML')}. \item Cell: ALL arises from two different types of lymphocytes (T-cell and B-cell). This specifies which for the ALL patients; There is no such information for the AML samples. It is a \code{\link{factor}} with levels \code{c('T-cell', 'B-cell', NA)}. }} \source{ Web page for \cite{Brunet2004}:\cr \url{http://www.broadinstitute.org/publications/broad872} Original data from Golub et al.:\cr \code{http://www-genome.wi.mit.edu/mpr/data_set_ALL_AML.html} } \description{ This data comes originally from the gene expression data from \cite{Golub et al. (1999)}. The version included in the package is the one used and referenced in \cite{Brunet et al. (2004)}. The samples are from 27 patients with acute lymphoblastic leukemia (ALL) and 11 patients with acute myeloid leukemia (AML). } \details{ The samples were assayed using Affymetrix Hgu6800 chips and the original data on the expression of 7129 genes (Affymetrix probes) are available on the Broad Institute web site (see references below). The data in \code{esGolub} were obtained from the web page related to the paper from \cite{Brunet et al. (2004)}, which describes an application of Nonnegative Matrix Factorization to gene expression clustering. (see link in section \emph{Source}). They contain the 5,000 most highly varying genes according to their coefficient of variation, and were installed in an object of class \code{\link[Biobase]{ExpressionSet-class}}. } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # requires package Biobase to be installed if( require(Biobase) ){ data(esGolub) esGolub \dontrun{pData(esGolub)} } } \references{ Golub TR, Slonim DK, Tamayo P, Huard C, Gaasenbeek M, Mesirov JP, Coller H, Loh ML, Downing JR, Caligiuri Ma, Bloomfield CD and Lander ES (1999). "Molecular classification of cancer: class discovery and class prediction by gene expression monitoring." _Science (New York, N.Y.)_, *286*(5439), pp. 531-7. ISSN 0036-8075, . Brunet J, Tamayo P, Golub TR and Mesirov JP (2004). "Metagenes and molecular pattern discovery using matrix factorization." _Proceedings of the National Academy of Sciences of the United States of America_, *101*(12), pp. 4164-9. ISSN 0027-8424, , . } \keyword{datasets} NMF/man/t.NMF.Rd0000644000176000001440000000164012305630424012646 0ustar ripleyusers\name{t.NMF} \alias{t.NMF} \title{Transformation NMF Model Objects} \usage{ \method{t}{NMF} (x) } \arguments{ \item{x}{NMF model object.} } \description{ \code{t} transpose an NMF model, by transposing and swapping its basis and coefficient matrices: \eqn{t([W,H]) = [t(H), t(W)]}. } \details{ The function \code{t} is a generic defined in the \pkg{base} package. The method \code{t.NMF} defines the trasnformation for the general NMF interface. This method may need to be overloaded for NMF models, whose structure requires specific handling. } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } x <- rnmf(3, 100, 20) x # transpose y <- t(x) y # factors are swapped-transposed stopifnot( identical(basis(y), t(coef(x))) ) stopifnot( identical(coef(y), t(basis(x))) ) } \seealso{ Other transforms: \code{\link{nneg}}, \code{\link{posneg}}, \code{\link{rposneg}} } NMF/man/nmfAlgorithm.Rd0000644000176000001440000000430512305630424014414 0ustar ripleyusers\name{nmfAlgorithm} \alias{nmfAlgorithm} \title{Listing and Retrieving NMF Algorithms} \usage{ nmfAlgorithm(name = NULL, version = NULL, all = FALSE, ...) } \arguments{ \item{name}{Access key. If not missing, it must be a single character string that is partially matched against the available algorithms in the registry. In this case, if \code{all=FALSE} (default), then the algorithm is returned as an \code{NMFStrategy} object that can be directly passed to \code{\link{nmf}}. An error is thrown if no matching algorithm is found. If missing or \code{NULL}, then access keys of algorithms -- that match the criteria \code{version}, are returned. This argument is assumed to be regular expression if \code{all=TRUE} or \code{version} is not \code{NULL}.} \item{version}{version of the algorithm(s) to retrieve. Currently only value \code{'R'} is supported, which searched for plain R implementations.} \item{all}{a logical that indicates if all algorithm keys should be returned, including the ones from alternative algorithm versions (e.g. plain R implementations of algorithms, for which a version based on optimised C updates is used by default).} \item{...}{extra arguments passed to \code{\link{getNMFMethod}} when \code{name} is not \code{NULL} and \code{all=FALSE}. It is not used otherwise.} } \value{ an \code{\linkS4class{NMFStrategy}} object if \code{name} is not \code{NULL} and \code{all=FALSE}, or a named character vector that contains the access keys of the matching algorithms. The names correspond to the access key of the primary algorithm: e.g. algorithm \sQuote{lee} has two registered versions, one plain R (\sQuote{.R#lee}) and the other uses optimised C updates (\sQuote{lee}), which will all get named \sQuote{lee}. } \description{ \code{nmfAlgorithm} lists access keys or retrieves NMF algorithms that are stored in registry. It allows to list } \examples{ \dontshow{# roxygen generated flag options(R_CHECK_RUNNING_EXAMPLES_=TRUE) } # list all main algorithms nmfAlgorithm() # list all versions of algorithms nmfAlgorithm(all=TRUE) # list all plain R versions nmfAlgorithm(version='R') } \seealso{ Other regalgo: \code{\link{canFit}} } NMF/.Rinstignore0000644000176000001440000000002712234465004013225 0ustar ripleyusersvignettes/cleveref.sty