densityClust/0000755000176200001440000000000014555733152012756 5ustar liggesusersdensityClust/NAMESPACE0000644000176200001440000000230014471055374014170 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(clustered,densityCluster) S3method(clusters,densityCluster) S3method(findClusters,densityCluster) S3method(labels,densityCluster) S3method(plot,densityCluster) S3method(plotMDS,densityCluster) S3method(plotTSNE,densityCluster) S3method(print,densityCluster) export(clustered) export(clusters) export(densityClust) export(estimateDc) export(findClusters) export(plotDensityClust) export(plotMDS) export(plotTSNE) importFrom(FNN,get.knn) importFrom(RColorBrewer,brewer.pal) importFrom(Rtsne,Rtsne) importFrom(ggplot2,aes_string) importFrom(ggplot2,geom_label) importFrom(ggplot2,geom_line) importFrom(ggplot2,geom_point) importFrom(ggplot2,geom_segment) importFrom(ggplot2,geom_text) importFrom(ggplot2,ggplot) importFrom(ggplot2,labs) importFrom(ggplot2,scale_color_manual) importFrom(ggplot2,theme) importFrom(ggplot2,theme_bw) importFrom(ggrepel,geom_label_repel) importFrom(grDevices,rainbow) importFrom(graphics,legend) importFrom(graphics,locator) importFrom(graphics,plot) importFrom(graphics,points) importFrom(gridExtra,grid.arrange) importFrom(stats,cmdscale) importFrom(stats,dist) importFrom(stats,rnorm) useDynLib(densityClust, .registration = TRUE) densityClust/README.md0000644000176200001440000001120014471074477014234 0ustar liggesusers # Clustering by fast search and find of density peaks [![R-CMD-check](https://github.com/thomasp85/densityClust/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/thomasp85/densityClust/actions/workflows/R-CMD-check.yaml) [![Codecov test coverage](https://codecov.io/gh/thomasp85/densityClust/branch/main/graph/badge.svg)](https://app.codecov.io/gh/thomasp85/densityClust?branch=main) [![CRAN_Release_Badge](http://www.r-pkg.org/badges/version-ago/densityClust)](https://CRAN.R-project.org/package=densityClust) [![CRAN_Download_Badge](http://cranlogs.r-pkg.org/badges/densityClust)](https://CRAN.R-project.org/package=densityClust) This package implement the clustering algorithm described by Alex Rodriguez and Alessandro Laio (2014). It provides the user with tools for generating the initial rho and delta values for each observation as well as using these to assign observations to clusters. This is done in two passes so the user is free to reassign observations to clusters using a new set of rho and delta thresholds, without needing to recalculate everything. ## Plotting Two types of plots are supported by this package, and both mimics the types of plots used in the publication for the algorithm. The standard plot function produces a decision plot, with optional colouring of cluster peaks if these are assigned. Furthermore `plotMDS()` performs a multidimensional scaling of the distance matrix and plots this as a scatterplot. If clusters are assigned observations are coloured according to their assignment. ## Cluster detection The two main functions for this package are `densityClust()` and `findClusters()`. The former takes a distance matrix and optionally a distance cutoff and calculates rho and delta for each observation. The latter takes the output of `densityClust()` and make cluster assignment for each observation based on a user defined rho and delta threshold. If the thresholds are not specified the user is able to supply them interactively by clicking on a decision plot. ## Usage ``` r library(densityClust) irisDist <- dist(iris[,1:4]) irisClust <- densityClust(irisDist, gaussian=TRUE) #> Distance cutoff calculated to 0.2767655 plot(irisClust) # Inspect clustering attributes to define thresholds ``` ``` r irisClust <- findClusters(irisClust, rho=2, delta=2) plotMDS(irisClust) ``` ``` r split(iris[,5], irisClust$clusters) #> $`1` #> [1] setosa setosa setosa setosa setosa setosa setosa setosa setosa setosa #> [11] setosa setosa setosa setosa setosa setosa setosa setosa setosa setosa #> [21] setosa setosa setosa setosa setosa setosa setosa setosa setosa setosa #> [31] setosa setosa setosa setosa setosa setosa setosa setosa setosa setosa #> [41] setosa setosa setosa setosa setosa setosa setosa setosa setosa setosa #> Levels: setosa versicolor virginica #> #> $`2` #> [1] versicolor versicolor versicolor versicolor versicolor versicolor #> [7] versicolor versicolor versicolor versicolor versicolor versicolor #> [13] versicolor versicolor versicolor versicolor versicolor versicolor #> [19] versicolor versicolor versicolor versicolor versicolor versicolor #> [25] versicolor versicolor versicolor versicolor versicolor versicolor #> [31] versicolor versicolor versicolor versicolor versicolor versicolor #> [37] versicolor versicolor versicolor versicolor versicolor versicolor #> [43] versicolor versicolor versicolor versicolor versicolor versicolor #> [49] versicolor versicolor virginica virginica virginica virginica #> [55] virginica virginica virginica virginica virginica virginica #> [61] virginica virginica virginica virginica virginica virginica #> [67] virginica virginica virginica virginica virginica virginica #> [73] virginica virginica virginica virginica virginica virginica #> [79] virginica virginica virginica virginica virginica virginica #> [85] virginica virginica virginica virginica virginica virginica #> [91] virginica virginica virginica virginica virginica virginica #> [97] virginica virginica virginica virginica #> Levels: setosa versicolor virginica ``` Note that while the iris dataset contains information on three different species of iris, only two clusters are detected by the algorithm. This is because two of the species (versicolor and virginica) are not clearly seperated by their data. ## Refences Rodriguez, A., & Laio, A. (2014). Clustering by fast search and find of density peaks. Science, 344(6191), 1492-1496. densityClust/man/0000755000176200001440000000000014555723732013534 5ustar liggesusersdensityClust/man/densityClust.Rd0000644000176200001440000000761313173652543016520 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/densityClust.R \name{densityClust} \alias{densityClust} \title{Calculate clustering attributes based on the densityClust algorithm} \usage{ densityClust(distance, dc, gaussian = FALSE, verbose = FALSE, ...) } \arguments{ \item{distance}{A distance matrix or a matrix (or data.frame) for the coordinates of the data. If a matrix or data.frame is used the distances and local density will be estimated using a fast k-nearest neighbor approach.} \item{dc}{A distance cutoff for calculating the local density. If missing it will be estimated with \code{estimateDc(distance)}} \item{gaussian}{Logical. Should a gaussian kernel be used to estimate the density (defaults to FALSE)} \item{verbose}{Logical. Should the running details be reported} \item{...}{Additional parameters passed on to \link[FNN:get.knn]{get.knn}} } \value{ A densityCluster object. See details for a description. } \description{ This function takes a distance matrix and optionally a distance cutoff and calculates the values necessary for clustering based on the algorithm proposed by Alex Rodrigues and Alessandro Laio (see references). The actual assignment to clusters are done in a later step, based on user defined threshold values. If a distance matrix is passed into \code{distance} the original algorithm described in the paper is used. If a matrix or data.frame is passed instead it is interpretted as point coordinates and rho will be estimated based on k-nearest neighbors of each point (rho is estimated as \code{exp(-mean(x))} where \code{x} is the distance to the nearest neighbors). This can be useful when data is so large that calculating the full distance matrix can be prohibitive. } \details{ The function calculates rho and delta for the observations in the provided distance matrix. If a distance cutoff is not provided this is first estimated using \code{\link[=estimateDc]{estimateDc()}} with default values. The information kept in the densityCluster object is: \describe{ \item{\code{rho}}{A vector of local density values} \item{\code{delta}}{A vector of minimum distances to observations of higher density} \item{\code{distance}}{The initial distance matrix} \item{\code{dc}}{The distance cutoff used to calculate rho} \item{\code{threshold}}{A named vector specifying the threshold values for rho and delta used for cluster detection} \item{\code{peaks}}{A vector of indexes specifying the cluster center for each cluster} \item{\code{clusters}}{A vector of cluster affiliations for each observation. The clusters are referenced as indexes in the peaks vector} \item{\code{halo}}{A logical vector specifying for each observation if it is considered part of the halo} \item{\code{knn_graph}}{kNN graph constructed. It is only applicable to the case where coordinates are used as input. Currently it is set as NA.} \item{\code{nearest_higher_density_neighbor}}{index for the nearest sample with higher density. It is only applicable to the case where coordinates are used as input.} \item{\code{nn.index}}{indices for each cell's k-nearest neighbors. It is only applicable for the case where coordinates are used as input.} \item{\code{nn.dist}}{distance to each cell's k-nearest neighbors. It is only applicable for the case where coordinates are used as input.} } Before running findClusters the threshold, peaks, clusters and halo data is \code{NA}. } \examples{ irisDist <- dist(iris[,1:4]) irisClust <- densityClust(irisDist, gaussian=TRUE) plot(irisClust) # Inspect clustering attributes to define thresholds irisClust <- findClusters(irisClust, rho=2, delta=2) plotMDS(irisClust) split(iris[,5], irisClust$clusters) } \references{ Rodriguez, A., & Laio, A. (2014). \emph{Clustering by fast search and find of density peaks.} Science, \strong{344}(6191), 1492-1496. doi:10.1126/science.1242072 } \seealso{ \code{\link[=estimateDc]{estimateDc()}}, \code{\link[=findClusters]{findClusters()}} } densityClust/man/plotMDS.Rd0000644000176200001440000000270513173652543015345 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/densityClust.R \name{plotMDS} \alias{plotMDS} \title{Plot observations using multidimensional scaling and colour by cluster} \usage{ plotMDS(x, ...) } \arguments{ \item{x}{A densityCluster object as produced by \code{\link[=densityClust]{densityClust()}}} \item{...}{Additional parameters. Currently ignored} } \description{ This function produces an MDS scatterplot based on the distance matrix of the densityCluster object (if there is only the coordinates information, a distance matrix will be calculate first), and, if clusters are defined, colours each observation according to cluster affiliation. Observations belonging to a cluster core is plotted with filled circles and observations belonging to the halo with hollow circles. This plotting is not suitable for running large datasets (for example datasets with > 1000 samples). Users are suggested to use other methods, for example tSNE, etc. to visualize their clustering results too. } \examples{ irisDist <- dist(iris[,1:4]) irisClust <- densityClust(irisDist, gaussian=TRUE) plot(irisClust) # Inspect clustering attributes to define thresholds irisClust <- findClusters(irisClust, rho=2, delta=2) plotMDS(irisClust) split(iris[,5], irisClust$clusters) } \seealso{ \code{\link[=densityClust]{densityClust()}} for creating \code{densityCluster} objects, and \code{\link[=plotTSNE]{plotTSNE()}} for an alternative plotting approach. } densityClust/man/findClusters.Rd0000644000176200001440000000367214470606244016472 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/densityClust.R \name{findClusters} \alias{findClusters} \alias{findClusters.densityCluster} \title{Detect clusters in a densityCluster obejct} \usage{ findClusters(x, ...) \method{findClusters}{densityCluster}(x, rho, delta, plot = FALSE, peaks = NULL, verbose = FALSE, ...) } \arguments{ \item{x}{A densityCluster object as produced by \code{\link[=densityClust]{densityClust()}}} \item{...}{Additional parameters passed on} \item{rho}{The threshold for local density when detecting cluster peaks} \item{delta}{The threshold for minimum distance to higher density when detecting cluster peaks} \item{plot}{Logical. Should a decision plot be shown after cluster detection} \item{peaks}{A numeric vector indicates the index of density peaks used for clustering. This vector should be retrieved from the decision plot with caution. No checking involved.} \item{verbose}{Logical. Should the running details be reported} } \value{ A densityCluster object with clusters assigned to all observations } \description{ This function uses the supplied rho and delta thresholds to detect cluster peaks and assign the rest of the observations to one of these clusters. Furthermore core/halo status is calculated. If either rho or delta threshold is missing the user is presented with a decision plot where they are able to click on the plot area to set the treshold. If either rho or delta is set, this takes presedence over the value found by clicking. } \examples{ irisDist <- dist(iris[,1:4]) irisClust <- densityClust(irisDist, gaussian=TRUE) plot(irisClust) # Inspect clustering attributes to define thresholds irisClust <- findClusters(irisClust, rho=2, delta=2) plotMDS(irisClust) split(iris[,5], irisClust$clusters) } \references{ Rodriguez, A., & Laio, A. (2014). \emph{Clustering by fast search and find of density peaks.} Science, \strong{344}(6191), 1492-1496. doi:10.1126/science.1242072 } densityClust/man/clusters.Rd0000644000176200001440000000312713173652543015666 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/densityClust.R \name{clusters} \alias{clusters} \alias{clusters.densityCluster} \title{Extract cluster membership from a densityCluster object} \usage{ clusters(x, ...) \method{clusters}{densityCluster}(x, as.list = FALSE, halo.rm = TRUE, ...) } \arguments{ \item{x}{The densityCluster object. \code{\link[=findClusters]{findClusters()}} must have been performed prior to this call to avoid throwing an error.} \item{...}{Currently ignored} \item{as.list}{Should the output be in the list format. Defaults to FALSE} \item{halo.rm}{Logical. should halo observations be removed. Defaults to TRUE} } \value{ A vector or list with cluster memberships for the observations in the initial distance matrix } \description{ This function allows the user to extract the cluster membership of all the observations in the given densityCluster object. The output can be formatted in two ways as described below. Halo observations can be chosen to be removed from the output. } \details{ Two formats for the output are available. Either a vector of integers denoting for each observation, which cluster the observation belongs to. If halo observations are removed, these are set to NA. The second format is a list with a vector for each group containing the index for the member observations in the group. If halo observations are removed their indexes are omitted. The list format correspond to the following transform of the vector format \code{split(1:length(clusters), clusters)}, where \code{clusters} are the cluster information in vector format. } densityClust/man/figures/0000755000176200001440000000000014534577027015201 5ustar liggesusersdensityClust/man/figures/README-unnamed-chunk-2-1.png0000644000176200001440000007006214471074477021702 0ustar liggesusersPNG  IHDRz4iCCPkCGColorSpaceGenericRGB8U]hU>+$΃Ԧ5lRфem,lAݝi&3i)>A['!j-P(G 3k~s ,[%,-:t} }-+*&¿ gPG݅ج8"eŲ]A b ;l õWϙ2_E,(ۈ#Zsێ<5)"E6N#ӽEkۃO0}*rUt.iei #]r >cU{t7+ԙg߃xuWB_-%=^ t0uvW9 %/VBW'_tMۓP\>@y0`D i|[` hh)Tj0B#ЪhU# ~yhu fp#1I/I"0! 'Sdd:J5ǖ"sdy#R7wAgdJ7kʕn^:}nWFVst$gj-tԝr_װ_7Z ~V54V }o[G=Nd>-UlaY5V}xg[?k&>srq߀].r_r_qsGjy4k iQܟBZ-<(d=dKO a/zv7]ǰod}sn?TF'|3Nn#I?"mzv~K=گsl<b|_|4>?pߋQrib 2* (Ѧh{28oIyes8';Z9h6g>xRx'b8ՃWOϫ[xn%|^z}%x c8eXIfMM*i_@IDATx Scx9)D<"C^x!+eL$ q!!*dBIB 2$3_u[~yg}[{﻾k&R$  H@D`6c6$  H@$  H@m%m+n3$  H@PzH@$  L$  H@9  H@$V ж63 H@$ $  H@@[ (@ۊ$  H@$  H@m%m+n3$  H@PzH@$  L$  H@9  H@$V ж63 H@$ $  H@@[ (@ۊ$  H@$  H@m%m+n3$  H@PzH@$  L$  H@9  H@$V ж63 H@$ $  H@@[ (@ۊ$  H@$  H@m%m+n3$  H@PzH@$  L$  H@9  H@$V ж63 H@$ $  H@@[ Llknf& H xꩧb33O*~6f}iƆ:*⊜W_30w?u4;쐋;?$0(@_[c 9W_}5qyʼn'rJl&kՎ{^Z6dGz3^y:[kb% PJ@#&w#7x#^|Ÿ/6XtEGXqgQ&L0&F H@=L`Bz~jxGmo{[h`,aԩqAG7UօHvՓ?qi fa裏i,M(M[2Pi?Y/Bkfi,nO4}Oewyc(ѧ'f-&M'ރ>o>89(mI'j (9:(% t⡇XF ~m[{w=ܱKd +diS?C| co}klD?ĜsΙ.kv"j%\2,fsxv˱{ƻ,o,oƛoYM">O^{l]}ճ[xᅃ>Zc饗!vXc@7u,Ks~| /-X|aYd\8̯>AZKx' Uy_ <կɓm뮻mlz@$  @FIo_swoOֵZ*d9?K6\s:^ qwedۓb=$j8roᆵ$ {|6ڨno[ԏgawqH%Kc-Y/kIՏOjɪƕ[o|R$ۓ1_/Y5iX%Էw,-FԳr-s\!.u$NkRמ}s}{z_-wvAMZ@  tEO %` /~k`D/|U}g}r1U3.[L<8[?@X q{9SL _, T}{_v饗Ʃ:~eK//QYw};馛Xv{co}+~ӟVOnX&7xxrZw\gKg^ykߞXu ty䑕W^w}EyO~iA1$c nwg$м,z0PKbV,XJkItշ7Z@c"5 Zc dz/ue2nZ=zYS8r(P\.RO.ѧg׾zźXn}WW^{`k7s1hJ9j-uc0͛P 6 M.K@=H@ hc$ #$`$0'uǻzWѥZL]Gώ gcg$-cb+]kޑ]`-8H~k糄bd}zXd_) j |2 r yXǵXxȀ"ڈPy_'2+Q$ݾN]K*Xʀ$te  0GWsbĝhc@B\pA Xge _:jя~4СyRߨ2S_m%?֫B5<~,vmH8h}sh~FϨj(qx.K@O`bWH@Fn;juk%3|)ćbʡ"~8g_-;b喋Y,JFR":S7xP/0Z+&VI+Ÿ@± +%br>jze50I'7~7/G+oH >}oLǕPy?'tܟ@ 32 )BRby$ @>,09l!(Ǖ/(1eS11~xtYg (>,fYf<%T'] )b?a.ܿ0k";̟->OGp3q?2_osz4ZYTBu꠩^xDi҈S05s蓈+@H7y$ BJwr4!}r1&z|,N!tOO DIdՏKVZQ_8)v'zdaے1Q dziK@=jf2UC4ku4{o-MZ__ʟ|<)V1VHz,XN?|L* ]vekR&' SlLK{} /~1>!ł[ed+]g_3MSd@0M_Kb(~Lzχ  ?YH_*#*!/@`Tu_BⳖɊ7Pi3*,uO6kiV>qD:F&,Y@J†w07H@h$ F"K@]AYF7+0,cm܏5t4[]gPh䲐-䃏g?x$%foƪz˭`6' t7໻,$ :e"!wֻ?+\$ "tț$ $  H@h1h$  H@ SƓO>^!=G3MiE$  H@<@*Fmuw-q9#Fh$  H`~x;nm8ϢK@$}{i_rL0!WKc=Gyd<3W!X:D`F$  H@#!p 7!2M -Pʁ5׃[I@$Qfqx-fYװu$  H@lA{d~wu]4zm߂>$  t4;,Xbx[p@:Yxnq\soEh$  H`|gc뭷"7ߌ_<=?zk1u:rK|C-qGDZs9glƊ?$  H@]H`bsϋ/8;N,08{FmgqFVE+ H@z@Y@otMsV[mUeoouY1l5ayK%  H@@ _>.xWr 6`ZX/w][!E>Ms1GL2e)U$  H]~AFzZk2,믿~|cI&9W^yexCng15 &L~ H@$ :믏~;|+f( $  H@E(]v~'pB<裏?Xxmo{[,ҝEH@$  t-g%~J H@$ 'u:œ$  H@hB@%  H@ZK@Z& H@$Є wK@$  MA$  H/X_ibG}ooi70eʔ,L81sf/ H@$@!M0!4iRjYhqw=#뮻YgG$  H@X:J:bc5׌W_}5F>~.O|c%  H@t]3ϜG3}]vW7[nel袋  H@$9N+(a(%  H@:@uw3  H@$0 P H@$ PGH@$  t8i _B0zuY{]wշCX{'olzԩSW^i$  H@} tEl;^ziy1eʔ5k??ַ6~ H@$ ];iW7re* H@$ЉZ8I'oyl4lUw, H@$ЁZes5׌VXe H@$ #*?=&%  H@:@OX@;E$  H@t0n$  H@ j$  H@P$  H@C@::\MU$  H` Y$  H`t(@GJ@$  @@:7K@$  p5U H@$ (@f H@$ !* H@$0`, H@$0:T%  H@ %  H@Ftt$  H@q$  H@PWS$  H@t0n$  H@ j$  H@P$  H@C@::\MU$  H` Y$  H`t(@GJ@$  @`7,H1q␓0mwH@$  >A[@Xvec.YgXq}JP$  Hew}w\x9#?X`c[o5}c=lYaLH$  H ^ղ<蠃rwV[mZf?w;|xgbɽOJ@$  @bu׍g}6vq>jYr~W_.$  H@t 9 _ϓO>9ZkXy_=o~ D:ⓟd\yy@Rp%  H@$0 ~-3#b-8#]$  H@@3 PkI&u]7xcs=y@l  H@$ Ptk $  H@~}@H@$  H`0d H@$ ):uxG[DŽ$  H@ZO+?'pBz?1S9cE]4^xOzZ( H@$0bC4GAP_颎;׿GuTl6ygoXeUFK@$  @ c9&O%fe-OgCrӚkG}t0(?񏦇AA$  H`hN׿]v%wS/}K n>5y㤓Nm0+_|q^M"Ty䑦  H@$З@ KXn岥s.;3>mSLo$  H@C!!>IOgJqgo?K$  H`,tet0;svT$  H@@g.xmֱ[;hw ?  H<3qdz>.lcIH-$ХRzg̿F,H&%  9n-6tOf>;\$=VO{z%Yko$  ,h6:O .K;S}{wuW}H@$  tm]tAqYg_ĉ΋:x.%  H@:@u#{i02,qg>x' H@$ %Еd HoWp;$  H@Ǝ@u*s$  H@hh+($  H@ (@ʈ$  H@ mEӐ$  H@4QQ$  Hh$  H@&4*#J@$  MC$  H`FeD H@$ VPiH@$  tШ( H@$  VP4 H@$ AP%  H@ZA@ ! H@$0h A2$  H@@+(@[A4$  H@M@:hTF$  H@hh+($  H@ (@ʈ$  H@ mEӐ$  H@4QQ$  Hh$  H@&4*#J@$  MCMsԩSt$  H (@{xh3ެ$  4! wK`oƔ)Skt^zxĨA$0 (@c[kO&g=r˸ H@x lDŽ@Vg߼'Nof( H@u ^oa7fYg8ӦW^ɖQ$  H@㑀c[s=;~3Ϝ#1=m)H@:Nk3{xWc9XbXjb|+=SO+" H@*-C%f| Vϛo9g  H@{[0 1iҤkKf" H@pvwxY< H@$k֢G$  t8h7œ$  H@F|@WYe0v??y8t9]tQC6g H@$ N{챱6kp@0c7C |ffkz؄ 1$  H@N_*VXa:uj>j[_~,y16~ H@$ "v*;,կO?IE,$  H@MtgVZ)[A˶^__^x!Igg*Z H@!N 70l{.jk0z!PAO4)[Xf$  H B s5WW[m#{8s[H@1l7<>C=,L|C?<s1Gyo~l}dMbw &:iNs9g.wy0ƀ/mW\Q?:1ƦnZ$  H`<:O~2O߱뮻ƿۿKtח[u?R&G~S=3[ox7[Ui1j%\2[ O8>ۻiBTZհAf|u-~=w1O?=fe1c H@c @?C;Su]q衇/~z--!,H0F|3ЩX_[iCbn_jT_"_q;nGuToϾfq0H@A.vP X:ݳ|vꫯfB ?s63]zWx(>o#ذ袋"+rm֍:cPBK>Zl?`&9a8?p!0H@FѤ$e]6xl};dϵ^;K/t, h8qbs9y`S=XL\s͜7]Հ?X503T@> Tz;3 0 l[c5⢋.YqyW /$~V$  H@: mHw3Ϝ\ a7͸##?.ԡNt뭷 G/; O2%~_L1u1tgFXBa[3tAqGJV`kc0's^y\|umɖM`RK-5KI& H@)-#%8F0r;Fcs_~-ܒ !2'M$9Pp ۟W]uUWe]r(l_lŲ0C ! ?A0Z%cM>ME|b$b ̩xsY3ԗys̾pO/~n$  @-aHb|gGN{HG4 a'?I2uqkɏv饗miPK-YDkɒXuYkId^{i2xs$V4 R-'%+[-Yj6[=m~Ӛ&q7@)˄$a׿/YQ󹔬y=ͯZnjijLz񩧙dyosA@\oх Պ~1 =X.Չ˙;-oyK ZJ7=~gSMtvmqQX97KW.ya5e3X,_Xa]g*]z QqiXc.,̊+Zt8P\_&q0 x \eYr|H@F]Iwi3'! /} _>PD.~62=%1gVg}6]w,*>OL32 S'3-t8>5"4(?xzambKܠksyg zby / H@@[t} .xIiݠtK˓`׷qɊUKkI>Ւ+oO>_^KUr;O~54`&Okt6$kiko}[s8=O<bՒ0볯SW:{\4R-}i*`K?7z/E1ceGcs:$  nRbV R|DD":DCc-ufpKFyd_y G|H֯}6s>YZv_%l%Lɵ4M9䐼-}^?_e[ZPň4p&&˯J9 n꒮0|]Ҁ|zu֩/>$?k\ 4A-ͯ}-SWy.')4V|oe #uO-͍J3L r)R4ug׷  H@E@[٧6%@$utj,>l]+tqbM#s"rz<0M_FZSG֫UHK< NSՒi-}ɩf4/3!4>IP־oN<oϖ4qzx|`䟚뜺:V^c=j OymN8"Ky3)#4sAir)N_bPDk8Aޖ>:8P0u+-$ vV)!@FѕꪫfK&b(n{DgVYz[|&"r?v9A@c{%¼=M㓷υ1bۊK–\F?4x& ZC^8 #n>BaN(]Τ?ʋ#M\J[mSxf(epHt5{)k*'$ܼ eK5,Uq2i%EþG OdSoL# Yxp.!X$W㱂ce'M$  H3(@;F)@N' 4]NAXX?Bt-]4Sr<+}2 D*P,XXi\.D!Flg_O>rtNL l:Xpنя~OMS]meODW-iy~AXꉰ4aA!7:+IDATś2/sJ8_wDd7ssXr[vˉGM@:lth Pj0dKnG![ A\vDN- Xuqgz#g?ӟ$ >%],Wx!U.c-G}=A ]wDD!yb}$ xYD5R)t3'`٫v9a&

9_\7P>O|y\,Եy/^gt8n`@q31Bx~+@G0a}zCWK= V~2hXc_U BX2O'2[/]/,B,#JzLuM0Dj)C8XV]J\)Nx!TQz|7fFJq(,#  bS?;)>5 9T%xN7zk& BR QtM๲w]ޞ&ςi_I2B?n^J?%/XX9xOy^WmbIT[^y}Y4 %]\iŝsH%)@{!@WFs!ACX d ”}L HX݈S~ܼk,QW_}u_S+ItXaVܘЬZ _r1F3}cm-ty(#mXYṉɍXp>a$:jВ^5m12ua>a h@{"%m!/umu,*^"9 0_l5bC>ޛ\"/Y 5`uAf>姚@e\UW]?KF>Ѽq\ŝxJ p+5p共0SO=5_NF;`ub)u\)!̠.͹ZLShz5/4+L%n(o E 0^>h8sXwh.:W%h tN;]yقǴ_x 0p/ sHǽbhŲ_YC`Iy$_xV/'gru˭'^(gsvntFŋ2g Ѥ;im>7:vR^DK`$8B܈ 8n92xA00 _ E\<ȟfXmt.~"k&' 7Xկm!UtIXY|8,ya)V^/s28 N(Vޒ6ixbk2G,ĥԍ.xnt#D%&/. "HVaFڤG9^,/n_ƱL@4Q>^J1.byvfZ\(<'01muv C@ x× <ɛ.V1mAU>?92z +pmޫi?BL/^,ӫu9²2yA\ˍ塬ps,SՑkZ'^H49'suR]^.;vQyyB`buHiQ;gq?P/ ܣ V- [TÆ '.x,XWw}HŠX,C,3<#]I Yb .ChbE)B2`%>bk.-eK Qnr]rҼQNXpᏎD&>(>QYU%^/'_~Fi#5Ҙp˔E{V_f`9H87ߑDžN0:澅 P/HY},c>UecD܇' ́ċ8|YQVlGds?j2v+򪦡e.n/9"úW1v jl>pBA#kbySԥUeSbT*@0eԏ8ʹ,塁xxpoeyh#{n?ˏeG!2GSPY@`-:QMMXEG~)q98 ,enRI|?<-]e8q/[Bܔy >/XxR4@x`i B$PNp<,xҶΙ2Ώ²\"0y2P`m*ef.▶B*.0b.E^θhoIyaF^qxs^XssNpvtEpE)/_(= ^8$OE VlK$rWEsHWp#brm2 H#3WsV %wzxANي)99G#(@Gjml"D 7\t"*ia.51 EAD!_QaPnE6ŢO&sFCEn9=f OUqã|Xcc? -i!\7M!O7:q(+sRXnHE$2 !Ԗ9KYtaJ8-\) 1OwE.sVK.Ct"E<#t5^e^O,Nj-VJҤ[/AnЩIنxR_0kL PkXRƴ:^9o6'|x?jZC]6 ˸ʋ bAkDa/6XMN;43\_ExIK@ we;֯V[S (G@}Wwe;'p3KDEMh*ܛ3F\=qʋ4z={P/\7닗11}1@˽vg(5˳=xACFjtX0^q'1V`Aq/がHD1 Eps2Utr3F:X:@>AX#8|)y 0a;7b-7aE$iA\rF(2"Il,Nܨx#.igJ7H\d&F$KevfP46R`@6Szޗn(ySJ_zH(H$#=#Y6ĩg$#,OHsIFz0Gz$X=8_ag0x/Nm_n#_~e-҃? B>$Srɇ< C6HduWٙ,KMKzٌ􂐯% >5FpmĦ;|cKk3{@9kz}Y6k{QOV,sVrWv{R5 o6ޞH"ꇥ^H=Kܲg]K.isܟC4'a:}hciI7=X$j]~J#ߋU!i$=sVb5,]XUfOtc"09~e,<$ n_SK74q!N' t V:ªFƥPJGP/XZcz#,nXd_"^ƫy?Wgz@R:#]CZU e p&WeLY.c-l+qXO4b#pׁ$slg[50Oz<մ67zJ,rw\#?.= Xt> XTK$ ʀ I=Ajesʈ5 5VrHoy5p]pE@9zivz~@VjܲKQ3]|EbD?sw<$kgP6M ]˃.9 kyA7@0eFrsFxqnndB^t p3M0E|U>3ig@P|x >Pi,+)@(B_W,n"^@Fl7;ʀjwiyYᅋ@y>vup)O5?َ0.YyVKc(k9uavtxQ)/Yӛcm/N-⺴=]e1Qƀ@ yi22֔וr2.*$uK;c`UPg/% B*|?aTsyR5J a{>/D(MI? 7k>x+Eܴbt*7XXiCsQX6TƅBIۅOb ֥D\Q2Ū8tJ\|ݰP`&/Uaܸ1Cσ*G)?֩|XƇQ- ⛺s. 6MÂ+|8'kj~-c%#]cs1 $h{A%]?O

p|b 7%$˳sϛe-xPqF *bs4pnsmׄ4 RW`w!|HFВk`7c4M>Ff #?>Eד%k@$^{mO1p 4+k \:nj'1Nu৊oZzH >⣊/hu"PonG뤶I]Jb!ԕwL$}H _$%%;ńȏ6NB"Eo$wl9W89ǂ&RN#c\_,OÝ6IB6_\,!Ys=/ |Iݨ I)tkj}BǧyN=|ov?ԥ{hgzkrNQdʾ\=1}:S/T$f[LEG{cRL MIz]"ߩ+SKʕ"-] dRmqmMI,>F4B2 A:w0p gM֌4Eax1Uk"Y^!t@y8Щm[70ぜ\*@$^o]|.|hBedB2rPV?p+v5:27f~% aoz83RJ>:0L1Y){Hm0:28HtEa^lfI$  H@@g:OL1fcqcH#iTq.%  H@Ƙ@ Pxc6m11n$  H`JZZQ~ H@$ t,3?E[R ;l,LiIEy"̙JMi2tU6dnVCw^ޚf߸O11lH*lٍip'_7̢yHsC2Ђ.Lr]lA&1<&s{vg ƦG><62׮th;͑uumKɈ]:L 6d+?sq 7䯝V_E|)[fX H@$ N'|$  H(@{A$  H@t No!' H@zH@$ N'|$  H(@{A$  H@t No!' H@zwH٬_~9Yd)WW{ ;$  H@0y$  H@ (@#%  H@A@: h" H@$0| H H@$ aPH@$  t;$  H@0!||5@ }7ڱ F"m^;cvy7a]+{w;feܖm]<#H4ƀ/x;bwrXuUcf^;N8Pj{:uj|+_^8fiXzsio!mT (@G饗bm͑8#TN[KbV[-7wqGlfku\y-Ps_hGkpM7Z+n>O\|WV 40rHq7džn;c\y䞮"0!;FMַOOzK,D^?g+M^q1ɓc„ ]`Kׇ?tSNQ|!+\?|x㍘k\n 1l?O袋)",׹6llI4qXylw lwZ~ ۗZj8蠃b5Ȯ0v7qǗ_~96;نTCm펷jgyO>Yr[>@EEE k\s?c'vą⢋."[mU7Wo\{,GqDQO?=.W zZ@ǰq8}J@W_}vWb (%/'k_Z3랒[*e3ă>wzXn@j\;~w.inӸ;uv-,(@Gg-1s= ϥJ;_eeY&.<LwR~e,W}!sdej;"5 '":ti{_җbUVvr5!``(RZ(&ψxBRr馛t/9HW޹d ST3G? h5t6$,} ZڎԆ'K[oݧTwyZMWhfc^3_y`ʉ9+c.C{ͳlFϡLsw1=󻲽/%zYbj~?1|U7ܡ`￿O uf3JW:|&O:=И{ǰdf={Wd7 .ϡ W&П5$vv-] xk)paT;,:{KOg;/ьMKDMn89NtI'M38itKa%mֱSO=5nn7vl?8v0Gx^_y2>GuP2`F4X>&MÒu(@[Er0.>fo{ܑ#HC%  H / }|G>Տtq,(@=$  H@JAHmmf$  H@ P H@$ PI@$  (@=$  H@J@Vf& H@$$  H@h+h[q$  H@s@$  Hmmf$  H@ P H@$ PI@$  (@=$  H@J@Vf& H@$$  H@h+h[q$  H@s@$  Hmmf$  H@ P H@$ PI@$  (@=$  H@J@Vf& H@$$  H@h+h[q$  H@s@$  Hmmf$  H@E  H@cGK/n)^}՘h.#㣝$  H@Z@;),$  H@㣝$  H@ Ўi " H@hgk) H@:c‚H@$ A@:>ZJ@$ !혦 $  H`|Pv$  Hc(@;),$  H@㣝$  H@ Ўi " H@hgk) H@:c‚H@$ A@:>ZJ@$ !혦 $  H`|Pv$  Hc(@;),$  H@㣝$  H@ Ўi " H@hgk) H@:c‚H@$ A@:>ZJ@$ !혦 $  H`|Ax&IENDB`densityClust/man/figures/README-unnamed-chunk-2-2.png0000644000176200001440000013746014471074477021711 0ustar liggesusersPNG  IHDRz4iCCPkCGColorSpaceGenericRGB8U]hU>+$΃Ԧ5lRфem,lAݝi&3i)>A['!j-P(G 3k~s ,[%,-:t} }-+*&¿ gPG݅ج8"eŲ]A b ;l õWϙ2_E,(ۈ#Zsێ<5)"E6N#ӽEkۃO0}*rUt.iei #]r >cU{t7+ԙg߃xuWB_-%=^ t0uvW9 %/VBW'_tMۓP\>@y0`D i|[` hh)Tj0B#ЪhU# ~yhu fp#1I/I"0! 'Sdd:J5ǖ"sdy#R7wAgdJ7kʕn^:}nWFVst$gj-tԝr_װ_7Z ~V54V }o[G=Nd>-UlaY5V}xg[?k&>srq߀].r_r_qsGjy4k iQܟBZ-<(d=dKO a/zv7]ǰod}sn?TF'|3Nn#I?"mzv~K=گsl<b|_|4>?pߋQrib 2* (Ѧh{28oIyes8';Z9h6g>xRx'b8ՃWOϫ[xn%|^z}%x c8eXIfMM*i_@IDATx`SǿI-{ϲ@Aw2d)ޢ{" {P *. = $s4/Б߫!}?7M;smn `     B"`/v (@$@$@$@$P(*n6F$@$@$@$@    B%@Pq1     * PgHHHHP P-TlHHHH(?$@$@$@$@Jhfc$@$@$@$@@    (T@ 7#    @Z P~HHHH BHHHH(3@$@$@$@$P(*n6F$@$@$@$@    B%@Pq1     * PgHHHHP P-TlHHHH(?$@$@$@$@Jhfc$@$@$@$@@    (T@ 7#    @Z P~HHHH @DHٳg{+#x_?ϸ71c O^všzѺuktv?ļyb ݻ5kDf㬳2oިoΜ9F_OM6L2HLL<*,˹\. 4ӧOǶmPn]رeD>믿PlY7./E"o9CX H ȏ @-7WÆ FR^=Oe榛n򴙙yZUjߟz)wLL{ݺuUGv^z%OM?svEr&BQwʕs]&2<B5 @B5nժU3eKFzz:v؁YfA<|(QyO=#GĤI;W]u*T`hCǏyԩ)UdA~ͨ:""'J**UTsŢ@sֲeK8p` KłIB{@e&9bM@D]6נKf;wqne}>3U5']j_rȴiӌ%K⧟~³>XVaTñcǰpB:/ٳ)))y)tBj=Cn޾}lѼysc[Bdddߟf&mO4Çf([}8.&8~xvmݞzssqcʔ)KXYr`X4^4ƍs,w E$@O@6m@/BF./N:M؎5S<**ʸV?74flhO-Zmۚі]wT?hMbŊ.2~- ZD+&%%Z[]֓{1iWlOzԭ¾eٲeF5*P齎# 5jdh˕+` Wj^ھ}{lذѣGCQ=`O>IKKÃ>hUvmǣE_}^s5ƸZ <؏{R `eO ԨQH=i/"tUV5_R%hۺ ]wi3GnLPR/}҇ˣVZox2BrkQZV?k[n5H 'o}&8I*[#c%wBBqhU< ތ2ZGϞ=h,{5MtYw'_N"h?Ek\0[ThϟRE(>/ܢ5#-O\ [ 6dBEt:x_}>eͼ0}nrr"eI(#"^-!<!ϧ:x/§Q6d;'S<-q-B[BOɓ'{ >܈8>OCíӮ]|[ݘ [Le9}myzOQ+CEZX -[ݢ2QC,,W-ZDh =gK*LjƍmAg{SjիW`K/˖OLO*[ܲT޷o{Ky#waĩ0h E'Np_|n}Ocƌ8pad\DClğs9}9STݢtGzT 7i&{I~vU nwlQ{ÌL?ZBx/h ËnҤM'|b?:nhT= Lh`6L!'-ꏸ4~ 6Uh@ɲ,xn,f]_!oT5bfʲQj`%p|嗞uA:?$k$=sZ6`jU;Sei/TfP\`FhK,X׹W9sxD:T|ݲ'ק^zy[ўϐcjȽ?ÓW/[)HSjVz}נy[oO9ˏσڻwoOzZcl 1u|HJ?__{Ν>xC$3oTzj}^iV>D5k_}TE1j>ah#=& u2kd:u!'K.kW_y YJn`aK=izFe_׹-^{]4^FVߡQ䪷siLO YF6+C fߨs{D۷^8IP ~n#}>l,̙fX :>eA& `矏SiH g@sf$2dy?}iPt5Фh G“?3XdG4_vA: ErB9SI୑25f?㼯Ϥnz UI@]A=0 LhΌB:W (lu^Tǎk9$5R)hb1mīHb^I8N1B14)1F2uE$ƏX{\0ѡ]V6bT;ˣtĉFQ" PL1Kː׺-+&T A$O)9s}Fp&/őV 2Ṷ *C.9jj:@cfUu.` z.̠.4Xl„ %uiMTc[Gԝ) @.$ @6B2 >5 # w 3d^3z]%9VBt ]4Ba0T%]BI4"78oh_>OL:DCIadex2y]n-#$u1%۞x[=ZinD1\$g_E֬nO5uik׮F>GNÊdMjxcޫg3}8P=FoZZ{\Pjԯ}TFsedIS$МI zsо1 je&re#N9׻ ^  @ |0@8^r?MT]~WFR R6f( m.ݚ67jܡKմku4-n0Y_|#%   %vHHH g9R    @b    (>(HIHHH (P i`'HHHHZ|#%   @4(    ChkHHHРvHHH g9R    @b    (>(HIHHH (P i`'HHHHZ|#%   @4(    ChkHHHРvHHH g9R    @b    (>(HIHHH (P i`'HHHHZ|#%   @4(    ChkHHHРvHHH g9R    AыĻヒ>!{vHH dffnfP9,"##1sLgI [ 9| J4 @֭F؂m`ƍh޼yPD#"" . %HH 5kDRRR7@ɒ%?VP+*#   (0@ -+&   "@Ԋ HHHH CˊIHHHP8    #@вb    +@0HHHHP-0HHHH[Qa\8~$+±={Q٨ۦUHHHbՋ,' B(NW1INfpDDE+, G\/^c޲l%\G#%lĹmFo.{ǦIHH  6<@"f-tLO^^ @pyq7{q=RP0gGCp8?d Ӊcڵ:FYPxTO.[ 7"KY%1HH L>UTgs=111;wnZtՏ=kW_. qqqXdIuLMxQ7q-dcd?hlH˗؞={btO~ǎ1~#= .E]DԫW?8=mSNE֭Qn]̜yr{ʕ+ aL2F'|4sA>}0aCqF|}Bȑ#ѴiS-[;wƎ;<ѱ=h֬J(c8~'O֋ݻwoFժUQ|ytp @e&Cd]{:{zw@ Bd$& m7Fsiy:99W^y!~'h׮xQj/b$$$૯ktAs=ЭY 4@ʕUVؿ?|Mv옻I&>͛7ww~w{8v-B'ȑ#nѮeNA/]4lEN?=?*a' p"Z.ŋ]4| ~כAm6Y? ޛAU#K/ԈVͩw?#ڷobPGB݅EVA_Zƍ{ﯽDp7TH|P 2R"zx_ej]B!p-@$@$@$C@uYXlOySdIC3{WJU uߣk4N63T^ݼ4ݻ)5^S^Vti5 gy;Epi0] d*tPlV_RVF~B(Ǔ4J$@$@$?T81bDTx2ȀN%PÇd=qd ֺ́V>5T!K/yt6؏ZJo)RaRnk]]vSjܥ@8i͚5hٲY] rȯ`EP bWIHH EvRUŸYV<5ٰaCo>ejXN:X`OUJ*T%/zgIbaXu.m}3ցC§U5A=!}{K-!P YHHH ~J_@}+%נV*؉!SN p#@5:I L KnH /0`sZnӦMռWVbNBjRU@|q*xvU3 V+;a{QVWU֭3Xh0 D$@$@ED@ڍnݺA] }^O5*RAV5ۤ.׋58J*ٳgHٳQTߠ0_}j>*S7k֬{ЀS(ѷz+UВR{:c L80ʩPH ~(t4o\l}cHHH@Su}IE['0MW!*AŖ[Q Vj\#'5Ҡr.b!@` 1HHH t sv¯2x^QF^y~7/g2X=Cl JފkFdLZ;?HHH$ $鎧kwºǣ洏QTb`&   P4B G6oE/# %lȮ(Y:C@5 $@$@$@$[@sK[Ȑ#mYe?K#?$K oIHHH 0 0{'~L%5ɊHHHrMhQߌ1NQKY'2HHH,P(_e:Ay.B$ݯLc$ XjEq>.x6U/gljw^; HhA t 6od[;ӱўW W|+OPLҥР}ėI XjEq9v~ѡgCԛXHH @jj*fΜP:/8S|Fu ]0<#bm|S C;8b8=d}@4g(}4V""FԂ HH b(~7oy#$w^9? 9?8TatU'0%A$@$@$PPBNڦM,Z~{L͛UfOHb    <9o߾P!tׯS va #Gbƌez    "rh-|ry睸rر#f͚.(h7$@$@$@$@9Tnݺ{zz:lzfddJ*VᒉsK$@$@$@$BR5QPF5 ""gf{   (b!-fǮFԩƎ]6~)c…hݺuNYN$@$@$@$E lj.5k'x"̿KrHHHH[^8)\2Sp8\ IHHH@9HHHHB,vHHHpEHHHB@ {.rCh*U   (BiȐ!޽; A#8MU%1HHHHڮ];t:#:6K$@$@$@$p:Bn ^_|/:f    ""rPqgZP3M`QvdȣIzKst$@$@$fBRs/TP!̦ñ"oV ;J(TG-ߊUDZC0HHH H <٭ q" < n z+$@$@$@Nh-V%l,[mvF + :3엇᝻ഒ>O制c   I*]D{ϝ $@$@$@H df v,d=JQS{oQ:U*anh73kpw5$@$@$@ALhON0umʭHnF맕ؽ=q~k'~ɝa $aw=6+'  _@gX6`~F8åY`㷋{1X=!ZګТik   5jQَ1z GD~]b  }GSSߟ /F?( W VZU) AR޵eU $@$@A@ycmlY ]4z>^ Ph_ЄàngP۠1 ^:3EDIqvy۵b<>~*(I>!QNw`?H۝Rg˓ o~5(TG ΄ @4<@Gӝnن dr,&?NI$@$!Gϭ߅m~gDx^Y Q?:qyޑc d\Hw9Q]Oߎ [{6&c\0k\;qHJϊHH[ (]2`2ƒ@%1N v[{jL0[b_'@j0}eW$@$@Gam`RK ,`hήs^ =Syf.T+' 933շ%N潟bqnh^HHB*4^l!|O)EI|ёѡ;@PxC$#gu;`沩ä۞c9f?\u>+2" VFj7аւMi'2#lxpI3 G<0H Gj^ʣ9c'[3JƊI5E:kCsO(.{h AIν[x駽ꫯL28sQ~}4hfÛ3#PESDZo4**[*q$@$@!BStH^[:R=˜E#puDo3 d:9 QXBN]|9/aÆ'D۶m_`Ȑ!([,v튥KzTkbm=lDgI$@$UГ̠ D2Ќ Fh'[w3߉JOC_/Ԕ[ Ь ?3\p3gn 8/FÆ 1tЬy52!T2r"X5▣*HHB@ZFj#F`-YUW#^y8To'1"T$mz’=҆t+wm:C#zc2 ""cqq8xUXS66 Sa]NwYmhƑ 9kt u򞍁3HR֫*dcU!2fH!"##ҥ oG]˕+ψ3#N@^V+AlgEE3bIt3kIH@2U`{{x@XH:lrʪm+Ѩzlu @uɂ f͚TR_гgOl۶m/o>'ls) ꊷ=fSj#oh @~VK$a?{44,԰ڎ͡ DGF#>&-B֥X$S%"1hw)gT; @?Fz +])7 sǩ1N+yRp6ChT+I+[Q1261(^ Ml ccpj APA)?׈OP'bo/t+2ihDDYbk Iդ„ś'ΐ7yZ(nSi`U#;Q t9/݉ ɳ7oÇC߃5_jA5TR%XYMv7>uꜾˁUs~D+;9 %.qm/A6sXÝ/B"6Ln>ޜ>tԉhG/:$ϐ. 4+C#=?'Ǝ:{]߿x.DU*m ݹaǞUk ~!F@(P=C KS~7bgŵ<_E{|cӎ5;W;T}YNX<[%Zb \۪K _HԚ@ 5j@Nr%LzA彣,ycA;]([/ɒ!#IBu:!FN |K]?‹1U.YRp Uk 1<݌{臈v'L_5 o5+ A^4~G)hr>^hT,>ԫW/ϽoҤ Sx cz p|2HJ8NUR#->#Bd^ 툶cд0gEƦΡH(_M4ՅIY a5z0?ɖi]C \LcZmG'\럋!e-EoAU2۠ObMrXVwю*._vN`\ePD˗>l/>Sϗ:Y @i/ӬAOR"=!zs.)ѯ.l=X ~tVō{(ޛ9u|@§UrDUrA PռݻO.;_l=~g@d˰ϙvNOA.-97{nyaM`ƪ'ϝHV-) @jBTT*Te"11p9ѣ?>~B9G47VWG#gcQ6c1"R1mC)5k 3 @2{ q8_]?#Ms׾V,nJJs+1Y BXDp8y>|8#!`r:^͛7m۶~C=()) eʔ1U i&?&LܹsQN\1l}(7rUuJOFx]? QRXIxҭ. *ڸ/CיUGJ 2" 7W] ӷV˿C[Фj o|Iy`/ ۏnEŸݪ?Tλm~V-I.qV]lʵ-gՋ h 64sAtt%W^yW\q矷!Yމ8 {ꉯTOC˦׾B#qȦ$מ96c<^˔?|"8a)Za Fq;Ih4l4YHsۏK1h8b;ֆǦ`g01v#nED)lX%~Ç_Fms]s^7,;WůjoKW1v0IC֊} .E\-K.E ګHtM{,9ӥ;kՔUK§3UMǏ`3a\כ1]XH#-, `H ḻ|tIeWGupefLni!yFDu*NŅZGc;*A5Olr-Fz-_vSR_/kg=`)|jk7qwqx1۲oۏbdS@i &@SZؾ:1cn>npɶ#~̑qή wu| _;Y-e#ÎaXqRvxDcv4Lkׯ{7"A֨z!oH-Z`HoF4h`8?ѫW/?~fE]Rc feC)KK_.dB&Zi LX!M5\ ZǪٖt[& Qo>M[a @Ȍ c qb"t$N OqWlz%ۆCw`^:oAHMO]kz^el5'tjF * "攚nc[Bd6^뾽d!@ 䌐iݺu wBlbh=322PJTVpCL,R]/&l싋D{ZɺTȩ<[2ikT5=b6w 0#,<,931ݹn!3ZހWw?GߋK5uzxn/u7w4"Ő0”'&'EUtb؂O dï. ֫5)x1r/3* G6Ϡy}&~Cl|Tю;VA /m,;D0ZC6iFDV!*-]ρ%2ղjdRЉH /x QMn#m-bVUZNf4AAϼT]So /[%]1rԪm+-k 7' Zg v5[ 0;jsa8x4eͦڛ AN!U%crI`2WD#|)K?i-)qעjB_|bGȐAՒ.'6VID_ !r2In8lt vo"\*pBRn{Vs5]yN+7!&*Vmwa-(DK٠=1Vz6uErצ}}7+q.Jvz7E:Ekě^ºKjtJI[\C72z8ApVؚ5 زyt'Ƌo7f@܍Fc.$eF5պ'1}o#cՈhV'DoiUyVIqzfSܺV%D`UXW%0F@sh7s?25%Č)m%x\*5]y9˧o‹3D -RUc[#8r uʺP)_kD[d<;qtgI_̾SI QB+#Dk;1aRh >=;|D8<ĸJ;/+ڎXFP|O3kbyB6<9cls޽sOk%泻X러E|o/Sm,3d;\OYw M"x}8Ș9U_%i|9͹ipqY2WLkKG_q&jGFD۷.rHM0V: jm<p֞MۙN3J>.[${:c:"1Q28+H9e}͎waxiY&Qjh|eW'2&lphL$.]ͭ!ɦj":}6rzh^*1L"E*Llow;0i4/jQ;h, (_R+T #\:z _. jx>RDֶr(_\ĺ̟eƗzBN-0^fߌ^bD!*UюfA^;F_#Ze!| P ߹ȎEx5m=D|2+L$YUVk[ *Geg d+Nrg}p=k xhxG> 50gLuCˤs ub2VWCT.NCF&˜ v]`-1j"ѡn p9⮉:%2H l<8mx'//Ό]TH̏?^0ά(M hhSRp񯜔aq.wC/O#q$梂b2NW:~2+\1N$~A]_2NܙJفB׫z 98ВS6OcpċЛF ˓!ǰ֦S=Lk/Z^6#GV聾n/B1GGqJS'>g4%Ӎ@<^vt&& Y8n_{UL9 !3UѴ㩈ɅuaÆUggE6x'IQFU$nssQi#4xȴHL&nzѝ Iz_!''˃kx8 _ë}<6a6'SFu7}'*fį۹L搓>斚Zr2[ &چaw5Y X=̚rK8Q*EH7{|cm8d,aYX"Qy%גR~TqNcMj6ąpƤKoVEtP6p_ڹf=qċۦ*I+^fqV1Hsoy-lU_Yyխ<6YGjԟ5VX]zeFV*U A>5:%Q~l]pA 1I@h͓ХY@ErL9X@?<`cp | qx_QGpr؅>m,P9d ?wid@$P| 2[SLGhF@}Xz[guOŖM(C~$!~zWB㼣 Z ]EEeJ{|:kCUNoD8Ory;Pb]*v]$Ɣ !LR(Du]|3PPthYgǢȒLXYRxK$P=2;B{C)Kv4sb^d5&/gWiQP*ǜ(wD.q9dcl]A0Yxُ1#Rɳlj7A֛% b}I7Ĕx a^q}dK!l@a>^dL4.^47'.=Fۉ4!l4Mf *"yla13/UK!H |S2:Lx;GW@ 6qd=cKh E)~*5NUWOj_fC5@M5q˱[SNn, r\͂r? KCw:&\7.e]%E[~{=gP&?o~`lF90eFUv93*R~2-EP]Ǐ!i`4ޭԸPu c4 :;퇽5^OtʌŸuUW\9rG>[Z8G69?.{#"E YUHiB1KgF> X$MĞCд;R~k{b9/zX|[Dd"./Op~w8LŹU[_ۛ||/Z q f}=4b/Ի7P+֭ i6LT#te> EhJ`VIcd9 ŕC#EĎa_eI$PMxnO ں x*S/eggm\ gz yHm]}{LLLzl5׽έ6|`UYI -bUϸntCfG߅Wz'< Cz5k՘蜺Z#T-#V>,KyZ]R-G\2G.|/{yU#ȍ%ѱk\YoK WY[WB\g `!@4Xf"1^h)BߨS_%D>KN_ &U, "ocipȀh.+Ewu$\bD!?->Q69C=P.dz7Rß7bc[oS6\B9EoN^KoYJ4d0HwH7z"('v߈ Ey W"`o-RؼK2uK ! `~)v"621JlR k=b7jwWMY ғn~e7:6i&Csg ޒ ~5ZLsklpm. pZ'Y6RL"{Sh֖EjZiK+9 DqںtN<筘PqԀ;TS&KAn:~< >|hj;ā{,iexiGvy)XBlRHe]tQ/4HޏJb^c8>U>g:N*!fmi4s`K, yk˘mҶJuÝ*6EOΜv߆3O9'!ꗦ?+dʢȐ~)I |pEG_Ut})v-Z5.~oßO F# +bUX9q:2Cs#rntgO>ݚ(φ"xHf02Eu?t=խMAϘg (<mGo1E?n-NQK]\.+ȑƧzy:ס SXliį~ G<7q\ #UkⱎL?Z/YX5cvemUMW:$Ef<:e9Gu 6"glSL4vA†"|.CqcÛ(qHݽ I5KH Tu¦+ݨ5$wxgD6/%fpu8So,M3Zy!Ǜ9 EDfl"#}" zZQK1wSN4BqL4IAgvYk+ǣzP0툿3 ߣ0/]e'+]%p%0G$~ȽZnpzKlQҎ˱j-;O.e9:5@pƚʉA]ֶNeSh4'FNɨ:Dž%Lu>CL|Im1C f}ʬwDԥSzRk ˺݃ 3чXp?ttb'ި*ty{!xnn߿5ֆS9ǧՍh{NQ4yԼ; , E8ujVs}Coڻ#{aї0{Xhq˹,2e<ͬୖ=]b6ʉ:][> JtO~ސ B?m8WYMiӀ "+\;Rt]+Rxt \{Lةxbm!/tQ|@I>S|7Kvde:'n\ҴO^ސ@(=nhÁ2e䜸 ]{sQ Q,eHuėͿ,> i/}(##)0ITQ+NX}7rEc_Iv^kb|=ץ>it!9.m+w EncGn+ 3#P&,npU#E3 ZUF9jt5~G.„EZ3IŽ:ИvQ"$w qJO%vu^_Q `\W$ƖU-Jj 1B_It~xw1fu!!!jBǎϣdI`^qB#4:Z5/3:|u"D@e1 Q9!˂]kXqU6zchо Lg#uAl}.ieY.-F YkCē%8F@ذs!|̲= ,G)s=8vvc8~bJ`_md17}>i9rH yfmxٳ' ͧ>Y8p6m1a̝;u 9SWD%J)[PyV"m-?ͮ詮QVAË>{%r>|9YMRWkMff5jޯyw "0m$E`;اH6Ǭ ƛ#Q"QY|:єW cTz5?^O!',1E9gD*++0|pCj8ŕ9*Id_@bc1t(n;ns~U.oח B {=u>T -zyA$:RҎ۩,]wg2#Kޢ&NnMR'?g<(?IIiХ) Mzņ"E PDJ Ҥ#&H!f.w{%qS|vnX9gו;f/ JA1̒N¨Q,*J˜1c}vKU|:[8d)ݍTf|DvߢhVB74WEL PoB OCg3T HqPsخgeZ{^4E:(`fZӫzy ҽ}"ٻ-6w"/y?kpb@씀F@7oॗ^޽UV7$&WfdQ(So/x%(\PwкPuXqP Dpּh̠Z ]1ФzbkREvO(4Y*j3&s Ld[ϚɚTbִ32&9 S@ bႍhۀFFFbٲeغu0MoWNq6\.'B !79-);[_):} ]  6;Gy˄wɩҰp/EԪvpSE9\=?&Rgi~v^_D3b(<^OP%kKsv+mUVD#) 43g+`Ѣ~*n]_% U~[<抯~XR{"ĵ!;Q^E|Z_ڔ}]jrBw( &S,Tt*DqD\3 (5N\iP8">F3'hxF¬)[’ᚄ׮ 'U~@M f$wd+KGȑ##+O*C&*>'" 1x͍-2R~ cU ;\nM5EwnrrVDL<,ۿﮂ%5Zvƛ߶^m^;6jO zïamߝPm)"PnMر#V^](V|JӦMtHII)0_yP{G Nwȳ *tw׽8 &W!QŝU1o ] D@ V,/u5ssYWŌkWB2fPtI9MۼsH'~*9n1_hQ-^hbtc؍E˫ꐖ GWIB*&L@xxxK,^ڲe 3prsE34n&l>IuҰ7kO ճFwQ)amqw~ Ue&D@#6qVPXΧuQ"V&^H$KT< W׎+EJQTYQ/@ĴG4mh3$]2Kʌ`*7)Pt 1cFd7^ J ڨRW? .r,P7wKLpA4"(u͒awͤ^ Z&Td*"$$?ʧ`žO‚ZIr X򝕹ų}j9 5N0rN`]Xuf1!mx2UOLs{˴rm> PIeo lzɶ_(ʑ\0y|\E5ѥQ#if;:Ѽ'$ Ш(lR^8p BBBONW]˜[' }BD8Uxx:T[^ZA-<i2RzM{;Ool5•L=+.Ճys>>U&559$RtXz  ǜ?A((V@HpTP{+.K|u? ;n]OK_V(<9¶l{ :N>-l ~.v-Z`._}U{җHOXiB}*ܘ +|\T~&~E쓈ԙJY&R_B]HZO"%@`H+nڭ=6(j?[A]|tE\W^Wlt\'bO_nIk1pk|Q~"S ) %K¶(Iifu)5 OKRa̘1ؾ}mw #1߀s{PvԾ-.?\*R98;+π=fr:Pi)r[#|dX4D^'YwD-Gm>T):hX|rG'K-H/G[v_I^z|5χt23w9)v mG<4o(pqݨZjt+*)nWcntfߞա3 A%nh>fTG˷޿w.^A깋Tժ4Hgim)ȗ"F@J~9;A«e#n]kL!m,[8|E~f O[Μߛt`s]@v'ĦA%l:Lr>XV|\Ig νٰ$ܓ~ذaJhll,n #IJe˰uVa.hAM|~"'/'$bӋz!rsǞe4ߎA nƕMO! ^w)ә _g؟ _͉<L)~n>Xr}shG5eF>)Bw~?3zUJm#m_똘<-kX'8Up=?w &Pǥ ̙3ѣeFMbEV9/m ;)ŐQ!)<ϰm~6S> (5> a>J Dzm0k+?Xy, S٦SktM/q:9Or? t #{]huryW_>/8W:c| !KQ*CvT6#D@$7ʙ +ܹʷ䣞|ᑟQ /5oEHf+j6lQGbc'r}}9}IqHyAU [aV18"`JCwO.C}lٞI¬is:[͎)I+!9,MiȔt7ƪ._z z ,Mg/<= NTdtT^)wqphA>]r"@ʞ$ll(WF87ped)p`zZv+y J$_t)?tS\Q1wPw.]1df#f/*- ! l /4ǡ`vf 4'K5׳P)9-l?xq?߇nݡ"d'*} h?VsGTW}"1tA^y #"PD\e/IP<wXeU3oBhd[jto+nVŋ/,0*MOwp,Uvwb#S'(Wto S Dxk:{ zcwi?QC|`x} u&b}2q|T+B _5| /e׷ c{-"G|;sjT0%5vhI0SYEcCoۧR Dvj;ע%9يw7Һ:?{*t~*wdC#Dp]T1xVAǧ%wdp5IV(\,k$1kDqןZe8:wh}MIࣳT=m$HHKl\|e;xXb<ؾL|g(t{< wɩNYONс)Sp&o>n3ի,}aE"`HPR"8VF廨 2;ƣҜ̚HMEt emM7s`=GWSGz g-޷$@/;a%h@|!y~tlԂ=VҼyI.lݩfh[8~ n>ޝt7y~9([ p+!9ɰh` 2Tn.QIo.ء˕璻aEpT+~e3,,rdld4 7G?}$;mv`1۫z9{AX~,"Ƭ#Ө?›: %qiB!f"A@aVOIzA=d fd(fԗ`[t{R-6k/gxU:qǮը2T-BKfů5S ~U uw(^W5w' #!Mi oe& nly<?dniZ5pFWEZG0QX3 ձm~ŀvCMk+s~xPȕ9L+N}$O4}A[@<LaS[5C .ˬCx/1[Q1bTfvk0M7P[ѣW+BL)G ?u^!$3d5w^k+Gnuȫ`?S~_CTc" 9J^ЦO#t9wFtJh=cjN]dd{kbgNM0 `IW#1`j$:&D |AΫ@闻 G3׌4߆-E@|j($qoMjd2N=u4N=0Lu5=b-꥙YiuP?N24 |*H>Y&|>[Ѷ4rɭX TUg`$~T[Mq̦xBrO6~{JuVnW0P;,~z+ܜܲr½zJ$ _AmGPJeQ#FXPD6ȤxT:v/e F(2CnP`ήOMJZBGV3\`UL6l-!݃[-ܘ6/aaSCsO]@g:lROFL̬Aީp,8"fU ׎)O6K,.;B~QpK}~԰?Pȕr|eh: Q J@V%ƉfL"{> ɻeuL5#Hb6|nu9z 4#" <)VR'Z%]`nÐ1DFvC ;ۉ.MOavyS"PH-EeTcTQ Rv>fP#U\0eՁ=\uz=+W7>c"`VXѿAY5u -| ?eq>ݸ?sâw2\#hYlL<]n6"MۡyrZ7?[aEˈR_VP(ݾ jGߵr6ΞnS$۶Ӄ*^3{Qv! R.Lώo"`CVei Wq Vt;J\f6hxFM)~ɘv Q_JmJ\6WOIp7M t0 'ۭjl@ɼL4 ?+"0KB>fkzҺBW6hs0 .^]%[P閏9F%-)e+^uOy3[4͘! SFSxN[vಷ3ZYAS=%p#p)Ԙmp'yf^Ӧb…aŶ< 5 a6jmdT ¥`N!P7- +ѵupV+[E:71QnC4Tܺd)s;ڼ&U:x"P&@%)y' ЧdkP3wK7ϜsFPШ_<w;_lʁ-I1>HV]zULQhlj)`A`}~&틁s1c{8鹏M3}wzXv5=p͸q٣:bFP ===^#r 0ʓOx9 DjKWei?5l%qsǠ5M|5Y)YIl!F|tIbs%柞 M GZNOa3 ~s}>ZCQ!f_ I&j7]Wc,SK8>۞ÚNy(~gGآ$gg<ִXt ;rF}MCjmp)"[NN7-BDL F(SA!p^ .UZ~Bŏ1[an;Vb/FX:)S: سĺl|f7`3 zJ7ȫiq!(iCuq;%|%>& CL+Ύ yU4nxۢ'߳q_(cD=em+j)-SexvρG 8c72"m 3a:Uvr-Сۧ\t@l#nbMͅՌ=aS[dmB1DpAYw~>ZCUθL 23H#UGd'[Omyb\r nV-=ӡKa'O$̽>-Y)3 /9w!XO `fx6$a'ֱQ=s3+nor֯}Wb::IDATGszQ? ګy([&@ -_+e{t7 iWH(74ҙَBgޙˆ*ji<HRD/P,oXlj;WzYƦyfB.Ocg,%VCm_uVT*j"(9i΋G8ch߬_6"-S V;P-!>} U*T`@tHby8U]fha{r*pyA:O<"%9C3'lԼfaÊ̶Qy*kװOa9я_1 K-*hs5Le68qKu\c&;@ vM%%#qq_t,G?=sy}e%}+!4(!c>K_mlN0j̿^Wxm eBezvVe:4cl^1\[M}8?V%ԿUzHmY $<ѭa/Trl"`HP4!\[bfז>BS뷕z3BU=LX&7i|S´=|SY﹥2ܹ=a g~@sBUY^Q-}xӢ_3{3pa82Q%t8xo:;?#Md7 SP37szsr6RP DlZ6܋Gע` Cl%ː}H4{N(D47E#i鞐Rp_{/]9AK\}_y\Բx_ƽ(8S;۾F+R TiN.k|>hq3pE i12'_Ip?8>:A΀p "1_1zVNyKQ;EĠ("@럄 nA$K]H곔~NpCao 6>n6s㞷T≀MdUh?So Xt7d1$ A+]sύ`Qϼ sdmʸf7߭gv VƵ30env.xX^,<){b߲jYG}wCUgs:ޣXS %GF@KmhPoZ,I&-04ۿ b0.VRmFMc˦{5#4E3c7v46QrEʹ%,9 H 7N@sͶC1*o| n1~tB{0ද'5{0w| _eND,R@Koj >A3R$>#ި>N,t  eM %="dcQ@-X6n_CPLVm*GeW84H]w\qGf'%WNG0=ꙓ^[IUʁoE>\{:6;VU#\?Omׯe̅'`m!D x%@JJ ?+W \%!Ki_}up=.x;!yloiviAm2'c &2-X )i1PBPI\YV9*T&Kc߯8a吭&UߦQfuo6ĀfCs<``-8,_0WCn5;׎ ~l2t颋+sݪ("PrK"8g-v~UWy(0 =͑}8p{cf_v!!ɍ9sF̾V-{g-[_~_ ///NFDك̞f0mGUW\dĆ2% z$&٭w{MG:mIJ9m_RqOg)J6cr%Y1g (bF 0+SNBV+oS-7y9"5 ynQ"~A'ӱgu(=S@M,X>,v܉^x'Nđ#GPfM|M[rtN@$0bLvubF>V ;+7ud$[D;ܥC2{Nkmvl*~5'h蠹c@jS܎T<b[+x<#to%]y54l'~GaZ~رe`|AM-6{jDkhvَD<!- *Vtn۹|qQ4n|C&fm28TY.^$,8"6YӂӲ&D fy~&OV>j"zmpuV#_}`kj d/[VϠ]h! @@)v8\ǴL?jץ!UJ?,E1 cA˫2@wW&3}nH@do[ FĶ*urQP2]Qzo87ץ}:Xa 6}GPs'I٨ӈ حz{"9wS9W+*}a}oXnmW+.6CjRx;O{:)x(q~R &ʍj/cǎXzi͝'oل^ }UTul7qp6wHGO}mZڄ."@'{osi_#^w,ު'Zy0kdZϣABbiFa \)bVOm(1r$.(;[d- &gϞf/|^/ƕXԉNq HhLg/O'MVIWBCUR&"@ʌ@\}L:9 _Cő4  rf^)"`b7S> 8_ ~\e\(CF{7p?!l7'b$+[u`)KhiՖ|38jYVΌ˷<%"K@ (w<}ZJpBW`tӧOKnO<ׯW-twfe^Bs T@nh[U?}K4"([|Kq)<<+Ӄ[2B l"EsCdT ӝM?pgDg&@k'y Ug.?",sy$6Z5",**^lv6 u3s"@,-[2_2 8!!!'?Ǎ7vZ[vBhh}tW buzx[HWi*.ݎ 6"itczṶ-f3"@ʜ@G'2䂣÷" @\M"sԩFeWWOYU:&{`SuјqM}g$ݰxq,@Y*eC*S̖C^MA?eGVӸtoL")gF9TYfk׮,>j!Q8R"({C,\sc/Y5nAsW_i^k0yq`cgۗPՃ7b{ɛ(\N>)f6T`#viг]VtnqyC{MovŔYMLJ5oЦO)'oIaGER&bҒ|4Φʝ~ 4:ht} YhlO=EO. _綕|z{zlmvmH{5{x1==hk=SgAe"k޼98PDwFժU-FRo_ϿEcPk C'OHn0 ̬,HV'>]}ZUB~ǚкAD]3 Dq9v#ٯFEؐ@KV(F *ت 㖍QP9B-G]#FU/<&yىL%C``KF*H?OUc3eEŐݰr|;YK̞v7ͬLϚ7MsG>H1D2V{xC.| xLtbyox s.ȡmd+D##4+` 7hUr"@D Hn A8s 2220zhAQѴiS <)))@Pґxc$wĺƶMd8"PN8!(&KFd||Eh ՠ< ,R¬.ʧ1-Z%PrI+_ҡ*GW fI_m.O9xe32"@F@y„\ y0ɝ}GD)73{9q+"K+/"Zijsox*HjXYJ,Y  $Ǧ8oȍ`KУqz|Чp} o Y%=A GmNϏVU̎iFٻIq{ugΦ`t~H A1(AT@y2WF9WlA{HdLg&;}"@RFS3olV=pԫq熟|#|i3-hȭ^ VʡH Pd*|xd= uh|j^J Dd el%RKPn]U2 zBL[Y@CD"E3;f`>+Maݠ]xrja8W ]JJBlηʏ}!MsJoyJ$Dl4-- Ν? e| )Zٞ$q[.>񸙨:fa0ZNU4{_}Xaēzs (tiü"PʍZ$mTMQqt\r@!7Z\v{W lTl,G#u*6.)P|Q˛NQZ#sg,/2Onp}̭ >WA~A0XӬtN(|NbXOVu (' pqtʧwcp9xVAF]xx9KlT',;6"f`u*cu_FŌ3X~!=;LY{h"oA!VwY&ZMPy"@l@Q@}|| b[#p&~;#hKY\"SIߕ0P;W|"N* c܀#xB_|Sm)+LSX'Kzu*^^g_r9a ܇fQ|kAgg_nHζ^;<+;!aX8|EQP"@$H!ID*CA)ʧvջx+Py(23rveM;=woTh?fU+drbh9$DR@m튐E-ʰZ^^:;NnCi TZ׋%J`Gzdrz/B4]|K%Omū.vWͻtRzu"_8e8"@lـE!xQťѱ j0mOGo*ެTJu9쩍uɒC#1CB/5JC"@l)zeH."`j7Sd8)P HYz"Tr:^;C&Cm@JY(!@Ss-H"`sh*cK@ˀ_fBD 7`哷^ >UH@ВJrC`հm8tU|4Us 7$;JZ'K!q8^zDzb7K &KQs6tN F/ El=?%q$#|*BU2>Zc}=ݢd:S n%[qv072&D00(/ DJױ+<*}dz\fk`cZBsGm i5F-"P"hDRD;GWr6Qcŧ"Pr zWh`gW$$DR@*S(uwXo=~D "@l)r%H"@fiemȈf`ҧ^O³5ZRg !@ C"@ AA=`8z<е~/xJ($ APӳ]! 'ЪN"@$ )L6 PQ~}L<t D"@lF@вeKa䓟ƍXv-֭[]v!44HD"@_S@gϞ-|ܹWn֬Yڵ+,YӧȈ/B>j Hbΰ]Z{o+7 D"P$7)5ʢT*3۷o/߅PMB%Z/66v&Ɉ DrG@r hq/ݻQjK6 ThwY+E("@ M@rSÆ WBccc1|pƓ/@> hdd$-[[OS$/bbo .z.`E D' 9A8s ^y=z~:t@DDZn]%@JJ<5]2]!A Diq +322pMaSK&i_^Kp̬r P D"@J$l(WFBZO} Zd*hj`T݇R@!huZdhҡf;)o DcɐR GGGqE_b4l(fC2}6}*-xoA(0h 8 jG nNn F #Pn@tWE))mٌț&z͵zoZ)6BCX:BbC|W u"@ [t„ 7+3\]aĂ;QӴbK ?dyiV:'D;!Pn3f.]ƍ+,koIL[No<- xM>-J @U@z >}XM6vf DNhZ{(GB#xxZ]2"@@!@ ɵ \\\LbOva"@ D INAɥKPn]:uJ, D"@l@Q@p9Z"@ D@@Q@:GqD"@ GPۻ&$ D"@5rbƌ ,:G D*xS>>>M"@ DPJ"@JV@h3J]j"Pf(2DHLI"=(26K3փF|\w'Dr|qkDo|snЄ&A \%UA;"@$MPI_>{&޺ W!S0< gwS Dj Wd D56n|r\Z D Z"@@0 ez֠N)D2$@ h§ OB @ h,Ԡ4uH M([-j"PdwPHJٸo릂D$@ hIҥ(2yz; Wn_*r=幠/~zzRطF^X4xMy: ?$>(^9צ@( rY^W,r97_sGWwcjԅ{Y"`sNns"Mv~hԞ (oKLI|[: %*Y͖pw&S"`[HA'0c;l;AĻ#Xuj3"D TW'@[sb))r=K !@ d. J샀LmvV9% DN_{M]#Df n+=YI0"@)q\DA̍@C]P')!DI TR%埀;31`݃,)w?*+h$1i$#GDBBQ:<>;v?c˖-RΊB. )XL{=_?p}4JH8JOOǫm۶)݃ г:N<޽{[_r!n ;ѣ9Yrw8{>_oD_ωy 5jx1EޑN>m再7永p)Z9q~p1CZ +V4x{{FmHAypгLhdRRZj:uol8F@mm d#{|ԊO)gw **;ʮ6lq9\]]QR%ĈEY|qr "qo JI@۶mLus9ĈXEAcZh=G>s8+V}$P(aÆ o>|'$O>|X~ĉYo Ą  4t6mO!P^=AWk׮q #C ɓN%tD&7e,Ďlv%)RZʷܰaMC@@`j2*}Rc:wL 1:6#d  Description: An improved implementation (based on k-nearest neighbors) of the density peak clustering algorithm, originally described by Alex Rodriguez and Alessandro Laio (Science, 2014 vol. 344). It can handle large datasets (> 100,000 samples) very efficiently. It was initially implemented by Thomas Lin Pedersen, with inputs from Sean Hughes and later improved by Xiaojie Qiu to handle large datasets with kNNs. License: GPL (>= 2) URL: https://github.com/thomasp85/densityClust BugReports: https://github.com/thomasp85/densityClust/issues Imports: FNN, ggplot2, ggrepel, grDevices, gridExtra, RColorBrewer, Rtsne Suggests: covr, testthat LinkingTo: cpp11 Encoding: UTF-8 RoxygenNote: 7.3.1 NeedsCompilation: yes Packaged: 2024-01-29 13:51:42 UTC; thomas Author: Thomas Lin Pedersen [aut, cre], Sean Hughes [aut], Xiaojie Qiu [aut] Repository: CRAN Date/Publication: 2024-01-29 14:30:02 UTC densityClust/tests/0000755000176200001440000000000014534372264014120 5ustar liggesusersdensityClust/tests/testthat/0000755000176200001440000000000014555733152015760 5ustar liggesusersdensityClust/tests/testthat/testEquivalenceToReferenceImplementation.R0000644000176200001440000000545513173654363026306 0ustar liggesusersset.seed(123) dists <- list( dist(matrix(rnorm(1000), ncol = 4)), dist(matrix(rnorm(1000), ncol = 20)), dist(matrix(rnorm(10000), ncol = 40)), dist(matrix(sample(1:100000, 1000), ncol = 4)), dist(matrix(sample(1:100000, 1000), ncol = 20)), dist(matrix(sample(1:100000, 1000), ncol = 50)) ) context("Reference implementation") # get dcs and reference targets source("generateReference.R") dcComparison <- simplify2array(Map(function(x, y) abs(1 - x / y) <= 0.15, dcs, referenceDcs)) test_that("Reference DCs and new DCs are within 15% of each other", { expect_true(all(dcComparison)) }) densityClustNewImp <- lapply(dists, densityClust) test_that("Test equivalence to reference implementation of densityClust", { expect_equal(densityClustReference, densityClustNewImp) }) # convenient for debugging, but calling non-exported functions not allowed in CRAN # localDensityNewImp <- Map(densityClust:::localDensity, dists, estimateDcNewImp) # test_that("Test equivalence to reference implementation of localDensity", { # expect_equal(localDensityReference, localDensityNewImp) # }) # # distanceToPeakNewImp <- Map(densityClust:::distanceToPeak, dists, localDensityNewImp) # test_that("Test equivalence to reference implementation of distanc eToPeak", { # expect_equal(distanceToPeakReference, distanceToPeakNewImp) # }) gaussianDensityClustNewImp <- lapply(dists, FUN = function(x) densityClust(x, gaussian = TRUE)) test_that("Test equivalence to reference implementation of gaussianDensityClust", { expect_equal(gaussianDensityClustReference, gaussianDensityClustNewImp) }) # convenient for debugging, but calling non-exported functions not allowed in CRAN # gaussianLocalDensityNewImp <- Map(f = function(x, y) densityClust:::localDensity(x, y, gaussian = TRUE), dists, estimateDcReference) # test_that("Test equivalence to reference implementation of localDensity", { # expect_equal(gaussianLocalDensityReference, gaussianLocalDensityNewImp) # }) #check the findDistValueByRowColInd return the correct index as desired: test_that("Test equivalence to reference implementation of gaussianDensityClust", { test <- dist(c(1:100)) test_mat <- as.matrix(test) cluster <- test_mat[, 1] newImp_res <- densityClust:::findDistValueByRowColInd(test, attr(test, 'Size'), which(cluster == 1), which(cluster != 1)) <= 4 oriImp_res <- as.vector(test_mat[cluster == 1, cluster != 1] <= 4) expect_equal(newImp_res, oriImp_res ) newImp_res <- densityClust:::findDistValueByRowColInd(test, attr(test, 'Size'), which(cluster == 4), which(cluster == 5)) oriImp_re <- as.vector(test_mat[cluster == 4, cluster == 5]) expect_equal(newImp_res, oriImp_re) dist_vals <- densityClust:::findDistValueByRowColInd(test, attr(test, 'Size'), 1:100, 1:100) expect_equal(dist_vals, as.vector(test_mat)) }) densityClust/tests/testthat/generateReference.R0000644000176200001440000000656113173652543021523 0ustar liggesusers# This code generates expected results from the initial reference implementation # (i.e. https://github.com/thomasp85/densityClust/commit/b038fb30ea6f59d60a3a4b45eaa3ac9a504951f6) # It is called by the testing code to compare the old results with the new. set.seed(123) dists <- list( dist(matrix(rnorm(1000), ncol = 4)), dist(matrix(rnorm(1000), ncol = 20)), dist(matrix(rnorm(10000), ncol = 40)), dist(matrix(sample(1:100000, 1000), ncol = 4)), dist(matrix(sample(1:100000, 1000), ncol = 20)), dist(matrix(sample(1:100000, 1000), ncol = 50)) ) referenceImplementation <- function(distance, dc, gaussian=FALSE) { if(missing(dc)) { dc <- reference_estimateDc(distance) } rho <- reference_localDensity(distance, dc, gaussian=gaussian) delta <- reference_distanceToPeak(distance, rho) res <- list(rho=rho, delta=delta, distance=distance, dc=dc, threshold=c(rho=NA, delta=NA), peaks=NA, clusters=NA, halo=NA, knn_graph = NA, nearest_higher_density_neighbor = NA, nn.index = NA, nn.dist = NA) class(res) <- 'densityCluster' res } reference_estimateDc <- function(distance, neighborRateLow=0.01, neighborRateHigh=0.02) { comb <- as.matrix(distance) size <- attr(distance, 'Size') dc <- min(distance) dcMod <- as.numeric(summary(distance)['Median']*0.01) while(TRUE) { neighborRate <- mean((apply(comb < dc, 1, sum)-1)/size) if(neighborRate > neighborRateLow && neighborRate < neighborRateHigh) break if(neighborRate > neighborRateHigh) { dc <- dc - dcMod dcMod <- dcMod/2 } dc <- dc + dcMod } cat('Distance cutoff calculated to', dc, '\n') dc } reference_distanceToPeak <- function(distance, rho) { comb <- as.matrix(distance) res <- sapply(1:length(rho), function(i) { peaks <- comb[rho>rho[i], i] if(length(peaks) == 0) { max(comb[,i]) } else { min(peaks) } }) names(res) <- names(rho) res } reference_localDensity <- function(distance, dc, gaussian=FALSE) { comb <- as.matrix(distance) if(gaussian) { res <- apply(exp(-(comb/dc)^2), 1, sum)-1 } else { res <- apply(comb < dc, 1, sum)-1 } if(is.null(attr(distance, 'Labels'))) { names(res) <- NULL } else { names(res) <- attr(distance, 'Labels') } res } # Because the new implementation of estimateDc does not maintain equality with # the previous implementation, calculate the cutoffs using the new # implementation. Then pass the calculated cutoffs into the reference # implementation and the new implementation to test that the rest of the # implementations are the same. dcs <- lapply(dists, estimateDc) # Reference DCs for comparison referenceDcs <- lapply(dists, reference_estimateDc) # non-Gaussian densityClustReference <- Map(referenceImplementation, dists, dcs) # convenient for debugging, but calling non-exported functions not allowed in CRAN # localDensityReference <- Map(reference_localDensity, dists, dcs) # # distanceToPeakReference <- Map(reference_distanceToPeak, dists, localDensityReference) # Gaussian gaussianDensityClustReference <- Map(referenceImplementation, dists, dcs, TRUE) # convenient for debugging, but calling non-exported functions not allowed in CRAN # gaussianLocalDensityReference <- Map(f = function(x, y) reference_localDensity(x, y, gaussian = TRUE), dists, estimateDcReference) densityClust/tests/testthat.R0000644000176200001440000000005013173652543016075 0ustar liggesuserslibrary(testthat) library(densityClust) densityClust/src/0000755000176200001440000000000014555726556013557 5ustar liggesusersdensityClust/src/findDistValueByRowColInd.cpp0000644000176200001440000000674614471056175021103 0ustar liggesusers#include #include #include #include using namespace cpp11::literals; [[cpp11::register]] cpp11::writable::doubles findDistValueByRowColInd(cpp11::doubles distance, int num_row, cpp11::integers row_inds, cpp11::integers col_inds) { int row_inds_len = row_inds.size(); int col_inds_len = col_inds.size(); cpp11::writable::doubles res(row_inds_len * col_inds_len); int i = 0; int dist_ind; for (int row = 0; row < row_inds_len; row++) { int row_ind = row_inds[row]; for (int col = 0; col < col_inds_len; col++) { int col_ind = col_inds[col]; if(row_ind == col_ind){ res[i] = 0; } else{ int row_ind_new; int col_ind_new; if(col_ind > row_ind) { int row_ind_tmp = row_ind; int col_ind_tmp = col_ind; row_ind_new = col_ind_tmp; col_ind_new = row_ind_tmp; } else{ row_ind_new = row_ind; col_ind_new = col_ind; } dist_ind = ((unsigned long long) num_row) * (col_ind_new - 1) + row_ind_new - 0.5 * (1 + col_ind_new) * ((unsigned long long) col_ind_new) - 1; res[i] = distance[dist_ind]; } i++; } } return res; } std::vector all_finite(cpp11::doubles x) { std::vector res; for (int i = 0; i < x.size(); i++) { if (x[i] < R_PosInf) { res.push_back(x[i]); } } return res; } [[cpp11::register]] cpp11::writable::list smallest_dist_rho_order_coords(cpp11::doubles ordered_rho, cpp11::doubles ordered_coords) { int sample_size = ordered_rho.size(); int dim_num = ordered_coords.size() / sample_size; cpp11::writable::doubles smallest_dist(sample_size); cpp11::writable::doubles nearest_higher_density_sample(sample_size); double current_dist; for (int cell_ind = 0; cell_ind < sample_size; cell_ind ++) { smallest_dist[cell_ind] = R_PosInf; nearest_higher_density_sample[cell_ind] = cell_ind; if(cell_ind == sample_size - 1) { // assign the last distance to the highest density peak cell std::vector all_finite_vals = all_finite(smallest_dist); auto maximal = std::max_element(all_finite_vals.begin(), all_finite_vals.end()); smallest_dist[cell_ind] = all_finite_vals[maximal - all_finite_vals.begin()]; nearest_higher_density_sample[cell_ind] = maximal - all_finite_vals.begin(); } for (int higher_local_density_cell_ind = cell_ind + 1; higher_local_density_cell_ind < sample_size; higher_local_density_cell_ind ++) { cpp11::writable::doubles source_coord(dim_num); cpp11::writable::doubles target_coord(dim_num); current_dist = 0; double tmp; for(int dim_num_tmp = 0; dim_num_tmp < dim_num; dim_num_tmp ++) { source_coord[dim_num_tmp] = ordered_coords[cell_ind + dim_num_tmp * sample_size]; target_coord[dim_num_tmp] = ordered_coords[higher_local_density_cell_ind + dim_num_tmp * sample_size]; tmp = source_coord[dim_num_tmp] - target_coord[dim_num_tmp]; current_dist += tmp * tmp; } current_dist = sqrt(current_dist); if(smallest_dist[cell_ind] > current_dist) { smallest_dist[cell_ind] = current_dist; nearest_higher_density_sample[cell_ind] = higher_local_density_cell_ind; } } } return {"smallest_dist"_nm = smallest_dist, "nearest_higher_density_sample"_nm = nearest_higher_density_sample}; } densityClust/src/localDensity.cpp0000644000176200001440000000244014471073021016670 0ustar liggesusers#include [[cpp11::register]] cpp11::writable::doubles gaussianLocalDensity(cpp11::doubles distance, int nrow, double dc) { int size = distance.size(); cpp11::writable::doubles half(size); for (int i = 0; i < size; i++) { double combOver = distance[i] / dc; double negSq = pow(combOver, 2) * -1; half[i] = exp(negSq); } int ncol = nrow; cpp11::writable::doubles result(nrow); std::fill(result.begin(), result.end(), 0.0); int i = 0; for (int col = 0; col < ncol; col++) { for (int row = col + 1; row < nrow; row++) { if(i > distance.size()){ break; } double temp = half[i]; result[row] += temp; result[col] += temp; i++; } } return result; } [[cpp11::register]] cpp11::writable::doubles nonGaussianLocalDensity(cpp11::doubles distance, int nrow, double dc) { int ncol = nrow; cpp11::writable::doubles result(nrow); std::fill(result.begin(), result.end(), 0.0); int i = 0; for (int col = 0; col < ncol; col++) { for (int row = col + 1; row < nrow; row++) { if(i > distance.size()){ break; } if (distance[i] < dc) { result[row] += 1; result[col] += 1; } else { // do nothing } i++; } } return result; } densityClust/src/distanceToPeak.cpp0000644000176200001440000000236214471073114017142 0ustar liggesusers#include [[cpp11::register]] cpp11::writable::doubles distanceToPeakCpp(cpp11::doubles distance, cpp11::doubles rho) { int size = rho.size(); cpp11::writable::doubles peaks(size); std::fill(peaks.begin(), peaks.end(), 0.0); cpp11::writable::doubles maximum(size); std::fill(maximum.begin(), maximum.end(), 0.0); int i = 0; for (int col = 0; col < size; col++) { for (int row = col + 1; row < size; row++) { double newValue = distance[i]; double rhoRow = rho[row]; double rhoCol = rho[col]; if (rhoRow > rhoCol) { double peaksCol = peaks[col]; if (newValue < peaksCol || peaksCol == 0) { peaks[col] = newValue; } } else if (newValue > maximum[col]) { maximum[col] = newValue; } if (rhoCol > rhoRow) { double peaksRow = peaks[row]; if (newValue < peaksRow || peaksRow == 0) { peaks[row] = newValue; } } else if (newValue > maximum[row]) { maximum[row] = newValue; } i++; } } for (int j = 0; j < size; j++) { if (peaks[j] == 0) { peaks[j] = double(maximum[j]); } else { // do nothing, peaks is already min } } return peaks; } densityClust/src/cpp11.cpp0000644000176200001440000000625314471057231015175 0ustar liggesusers// Generated by cpp11: do not edit by hand // clang-format off #include "cpp11/declarations.hpp" #include // distanceToPeak.cpp cpp11::writable::doubles distanceToPeakCpp(cpp11::doubles distance, cpp11::doubles rho); extern "C" SEXP _densityClust_distanceToPeakCpp(SEXP distance, SEXP rho) { BEGIN_CPP11 return cpp11::as_sexp(distanceToPeakCpp(cpp11::as_cpp>(distance), cpp11::as_cpp>(rho))); END_CPP11 } // findDistValueByRowColInd.cpp cpp11::writable::doubles findDistValueByRowColInd(cpp11::doubles distance, int num_row, cpp11::integers row_inds, cpp11::integers col_inds); extern "C" SEXP _densityClust_findDistValueByRowColInd(SEXP distance, SEXP num_row, SEXP row_inds, SEXP col_inds) { BEGIN_CPP11 return cpp11::as_sexp(findDistValueByRowColInd(cpp11::as_cpp>(distance), cpp11::as_cpp>(num_row), cpp11::as_cpp>(row_inds), cpp11::as_cpp>(col_inds))); END_CPP11 } // findDistValueByRowColInd.cpp cpp11::writable::list smallest_dist_rho_order_coords(cpp11::doubles ordered_rho, cpp11::doubles ordered_coords); extern "C" SEXP _densityClust_smallest_dist_rho_order_coords(SEXP ordered_rho, SEXP ordered_coords) { BEGIN_CPP11 return cpp11::as_sexp(smallest_dist_rho_order_coords(cpp11::as_cpp>(ordered_rho), cpp11::as_cpp>(ordered_coords))); END_CPP11 } // localDensity.cpp cpp11::writable::doubles gaussianLocalDensity(cpp11::doubles distance, int nrow, double dc); extern "C" SEXP _densityClust_gaussianLocalDensity(SEXP distance, SEXP nrow, SEXP dc) { BEGIN_CPP11 return cpp11::as_sexp(gaussianLocalDensity(cpp11::as_cpp>(distance), cpp11::as_cpp>(nrow), cpp11::as_cpp>(dc))); END_CPP11 } // localDensity.cpp cpp11::writable::doubles nonGaussianLocalDensity(cpp11::doubles distance, int nrow, double dc); extern "C" SEXP _densityClust_nonGaussianLocalDensity(SEXP distance, SEXP nrow, SEXP dc) { BEGIN_CPP11 return cpp11::as_sexp(nonGaussianLocalDensity(cpp11::as_cpp>(distance), cpp11::as_cpp>(nrow), cpp11::as_cpp>(dc))); END_CPP11 } extern "C" { static const R_CallMethodDef CallEntries[] = { {"_densityClust_distanceToPeakCpp", (DL_FUNC) &_densityClust_distanceToPeakCpp, 2}, {"_densityClust_findDistValueByRowColInd", (DL_FUNC) &_densityClust_findDistValueByRowColInd, 4}, {"_densityClust_gaussianLocalDensity", (DL_FUNC) &_densityClust_gaussianLocalDensity, 3}, {"_densityClust_nonGaussianLocalDensity", (DL_FUNC) &_densityClust_nonGaussianLocalDensity, 3}, {"_densityClust_smallest_dist_rho_order_coords", (DL_FUNC) &_densityClust_smallest_dist_rho_order_coords, 2}, {NULL, NULL, 0} }; } extern "C" attribute_visible void R_init_densityClust(DllInfo* dll){ R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); R_forceSymbols(dll, TRUE); } densityClust/R/0000755000176200001440000000000014555723476013167 5ustar liggesusersdensityClust/R/cpp11.R0000644000176200001440000000134014471057231014216 0ustar liggesusers# Generated by cpp11: do not edit by hand distanceToPeakCpp <- function(distance, rho) { .Call(`_densityClust_distanceToPeakCpp`, distance, rho) } findDistValueByRowColInd <- function(distance, num_row, row_inds, col_inds) { .Call(`_densityClust_findDistValueByRowColInd`, distance, num_row, row_inds, col_inds) } smallest_dist_rho_order_coords <- function(ordered_rho, ordered_coords) { .Call(`_densityClust_smallest_dist_rho_order_coords`, ordered_rho, ordered_coords) } gaussianLocalDensity <- function(distance, nrow, dc) { .Call(`_densityClust_gaussianLocalDensity`, distance, nrow, dc) } nonGaussianLocalDensity <- function(distance, nrow, dc) { .Call(`_densityClust_nonGaussianLocalDensity`, distance, nrow, dc) } densityClust/R/densityClust-package.R0000644000176200001440000000421414555723471017371 0ustar liggesusers#' Clustering by fast search and find of density peaks #' #' This package implement the clustering algorithm described by Alex Rodriguez #' and Alessandro Laio (2014). It provides the user with tools for generating #' the initial rho and delta values for each observation as well as using these #' to assign observations to clusters. This is done in two passes so the user is #' free to reassign observations to clusters using a new set of rho and delta #' thresholds, without needing to recalculate everything. #' #' @section Plotting: #' Two types of plots are supported by this package, and both mimics the types of #' plots used in the publication for the algorithm. The standard plot function #' produces a decision plot, with optional colouring of cluster peaks if these #' are assigned. Furthermore [plotMDS()] performs a multidimensional #' scaling of the distance matrix and plots this as a scatterplot. If clusters #' are assigned observations are coloured according to their assignment. #' #' @section Cluster detection: #' The two main functions for this package are [densityClust()] and #' [findClusters()]. The former takes a distance matrix and optionally #' a distance cutoff and calculates rho and delta for each observation. The #' latter takes the output of [densityClust()] and make cluster #' assignment for each observation based on a user defined rho and delta #' threshold. If the thresholds are not specified the user is able to supply #' them interactively by clicking on a decision plot. #' #' @examples #' irisDist <- dist(iris[,1:4]) #' irisClust <- densityClust(irisDist, gaussian=TRUE) #' plot(irisClust) # Inspect clustering attributes to define thresholds #' #' irisClust <- findClusters(irisClust, rho=2, delta=2) #' plotMDS(irisClust) #' split(iris[,5], irisClust$clusters) #' #' @seealso [densityClust()], [findClusters()], [plotMDS()] #' #' @references Rodriguez, A., & Laio, A. (2014). *Clustering by fast search and find of density peaks.* Science, **344**(6191), 1492-1496. doi:10.1126/science.1242072 #' #' @keywords internal "_PACKAGE" ## usethis namespace: start #' @useDynLib densityClust, .registration = TRUE ## usethis namespace: end NULL densityClust/R/plotDensityClust.R0000644000176200001440000001512713173652543016640 0ustar liggesusers#' @name plotDensityClust #' @title Plot densityCluster results #' @description Generate a single panel of up to three diagnostic plots for a #' \code{densityClust} object. #' #' @param x A densityCluster object as produced by \code{\link{densityClust}} #' @param type A character vector designating which figures to produce. Valid #' options include \code{"dg"} for a decision graph of \eqn{\delta} vs. #' \eqn{\rho}, \code{"gg"} for a gamma graph depicting the decrease of #' \eqn{\gamma} (= \eqn{\delta} * \eqn{\rho}) across samples, and \code{"mds"}, #' for a Multi-Dimensional Scaling (MDS) plot of observations. Any combination #' of these three can be included in the vector, or to produce all plots, #' specify \code{type = "all"}. #' @param n Number of observations to plot in the gamma graph. #' @param mds A matrix of scores for observations from a Principal Components #' Analysis or MDS. If omitted, and a MDS plot has been requested, one will #' be calculated. #' @param dim.x,dim.y The numbers of the dimensions to plot on the x and y #' axes of the MDS plot. #' @param col Vector of colors for clusters. #' @param alpha Value in \code{0:1} controlling transparency of points in the #' decision graph and MDS plot. #' #' @return A panel of the figures specified in \code{type} are produced. #' If designated, clusters are color-coded and labelled. If present in #' \code{x}, the rho and delta thresholds are designated in the #' decision graph by a set of solid black lines. #' #' @author Eric Archer \email{eric.archer@@noaa.gov} #' #' @examples #' data(iris) #' data.dist <- dist(iris[, 1:4]) #' pca <- princomp(iris[, 1:4]) #' #' # Run initial density clustering #' dens.clust <- densityClust(data.dist) # #' op <- par(ask = TRUE) #' #' # Show the decision graph #' plotDensityClust(dens.clust, type = "dg") #' #' # Show the decision graph and the gamma graph #' plotDensityClust(dens.clust, type = c("dg", "gg")) #' #' # Cluster based on rho and delta #' new.clust <- findClusters(dens.clust, rho = 4, delta = 2) #' #' # Show all graphs with clustering #' plotDensityClust(new.clust, mds = pca$scores) #' #' par(op) #' #' @importFrom RColorBrewer brewer.pal #' @importFrom ggplot2 ggplot aes_string geom_text geom_point geom_segment labs #' theme_bw theme scale_color_manual geom_line geom_label #' @importFrom ggrepel geom_label_repel #' @importFrom gridExtra grid.arrange #' @importFrom grDevices rainbow #' @export #' plotDensityClust <- function(x, type = "all", n = 20, mds = NULL, dim.x = 1, dim.y = 2, col = NULL, alpha = 0.8) { type <- tolower(type) if(any(pmatch(type, "all", nomatch = 0))) type <- c("dg", "gg", "mds") df <- data.frame( rho = x$rho, delta = x$delta, gamma = x$rho * x$delta, peaks = FALSE, cluster = factor(x$clusters), halo = x$halo ) df$peaks[x$peaks] <- TRUE if(is.null(col)) { num.cols <- max(nlevels(df$cluster), 3) col <- if(num.cols <= 8) { brewer.pal(num.cols, "Set2") } else if(num.cols <= 12) { brewer.pal(num.cols, "Set3") } else rainbow(num.cols + 1)[1:num.cols] } plots <- list(dg = NULL, gg = NULL, mds = NULL) # Plot decision graph (dg) if(any(pmatch(type, "dg", nomatch = 0))) { plots$dg <- ggplot(df, aes_string(x = "rho", y = "delta")) if(!any(is.na(x$threshold))) { rho <- x$threshold["rho"] delta <- x$threshold["delta"] thresh.df <- data.frame( x = c(rho, rho), y = c(delta, delta), xend = c(rho, Inf), yend = c(Inf, delta) ) plots$dg <- plots$dg + geom_segment( aes_string(x = "x", xend = "xend", y = "y", yend = "yend"), data = thresh.df, inherit.aes = F, lineend = "butt" ) } if(any(df$peaks)) { plots$dg <- plots$dg + geom_label( aes_string(label = "cluster", color = "cluster"), data = df[df$peaks, ], fontface = "bold", alpha = alpha ) + scale_color_manual(values = col) } plots$dg <- plots$dg + geom_point( data = df[!df$peaks, ], size = 3, color = "gray50", alpha = alpha ) + labs(x = expression(rho), y = expression(delta), color = "Cluster") + theme(legend.position = "none") } # Plot gamma graph (gg) if(any(pmatch(type, "gg", nomatch = 0))) { gg.df <- df[order(df$gamma, decreasing = TRUE), ] gg.df <- gg.df[1:n, , drop = FALSE] gg.df$Sample <- 1:nrow(gg.df) plots$gg <- ggplot(gg.df, aes_string(x = "Sample", y = "gamma")) + geom_line() if(any(gg.df$peaks)) { plots$gg <- plots$gg + geom_label( aes_string(label = "cluster", color = "cluster"), data = gg.df[gg.df$peaks, , drop = FALSE], fontface = "bold", alpha = alpha ) + scale_color_manual(values = col) } plots$gg <- plots$gg + geom_point( data = gg.df[!gg.df$peaks, , drop = FALSE], size = 3, color = "gray50" ) + labs(y = expression(gamma), color = "Cluster") + theme(legend.position = "none") } # Plot MDS (mds) if(any(pmatch(type, "mds", nomatch = 0))) { if(is.null(mds)) mds <- cmdscale(x$distance, k = max(dim.x, dim.y)) df$x <- mds[, dim.x] df$y <- mds[, dim.y] plots$mds <- ggplot() plots$mds <- if(all(is.na(df$cluster))) { plots$mds + geom_point( aes_string(x = "x", y = "y"), data = df, size = 3, color = "gray50", alpha = alpha ) } else { plots$mds + geom_point( aes_string(x = "x", y = "y", color = "cluster"), data = df[df$halo, , drop = FALSE], shape = 21, size = 3 ) + geom_point( aes_string(x = "x", y = "y", color = "cluster"), data = df[!df$halo, , drop = FALSE], size = 3, alpha = alpha ) + geom_label_repel( aes_string(x = "x", y = "y", label = "cluster", color = "cluster"), data = df[df$peaks, , drop = FALSE], size = 6, fontface = "bold", alpha = alpha ) + scale_color_manual(values = col, na.value = "gray50") } plots$mds <- plots$mds + labs(x = paste("Dimension", dim.x), y = paste("Dimension", dim.y)) + theme(legend.position = "none") } has.plot <- !sapply(plots, is.null) switch( sum(has.plot), print(plots[[which(has.plot)]]), { plots <- plots[has.plot] if("mds" %in% names(plots)) plots$nrow <- 2 else plots$ncol <-2 do.call(grid.arrange, plots) }, { plots$layout_matrix <- matrix(c(1, 3, 2, 3), nrow = 2) do.call(grid.arrange, plots) } ) }densityClust/R/densityClust.R0000644000176200001440000006042414471056255016001 0ustar liggesusers#' Computes the local density of points in a distance matrix #' #' This function takes a distance matrix and a distance cutoff and calculate the #' local density for each point in the matrix. The computation can either be #' done using a simple summation of the points with the distance cutoff for each #' observation, or by applying a gaussian kernel scaled by the distance cutoff #' (more robust for low-density data) #' #' @param distance A distance matrix #' #' @param dc A numeric value specifying the distance cutoff #' #' @param gaussian Logical. Should a gaussian kernel be used to estimate the #' density (defaults to `FALSE`) #' #' @return A vector of local density values, the index matching row and column #' indexes in the distance matrix #' #' @noRd #' localDensity <- function(distance, dc, gaussian = FALSE) { # These implementations are faster by virtue of being written in C++ # They also avoid the need to convert `distance` to a matrix. if (gaussian) { res <- gaussianLocalDensity(distance, attr(distance, "Size"), dc) } else { res <- nonGaussianLocalDensity(distance, attr(distance, "Size"), dc) } if (is.null(attr(distance, 'Labels'))) { names(res) <- NULL } else { names(res) <- attr(distance, 'Labels') } res } #' Calculate distance to closest observation of higher density #' #' This function finds, for each observation, the minimum distance to an #' observation of higher local density. #' #' @param distance A distance matrix #' #' @param rho A vector of local density values as outputted by [localDensity()] #' #' @return A vector of distances with index matching the index in rho #' #' @noRd #' distanceToPeak <- function(distance, rho) { # This implementation is faster by virtue of being written in C++. # It also avoids the need to convert `distance` to a matrix. res <- distanceToPeakCpp(as.numeric(distance), as.numeric(rho)); names(res) <- names(rho) res } #' Estimate the distance cutoff for a specified neighbor rate #' #' This function calculates a distance cutoff value for a specific distance #' matrix that makes the average neighbor rate (number of points within the #' distance cutoff value) fall between the provided range. The authors of the #' algorithm suggests aiming for a neighbor rate between 1 and 2 percent, but #' also states that the algorithm is quite robust with regards to more extreme #' cases. #' #' @note If the number of points is larger than 448 (resulting in 100,128 #' pairwise distances), 100,128 distance pairs will be randomly selected to #' speed up computation time. Use [set.seed()] prior to calling #' `estimateDc` in order to ensure reproducable results. #' #' @param distance A distance matrix #' #' @param neighborRateLow The lower bound of the neighbor rate #' #' @param neighborRateHigh The upper bound of the neighbor rate #' #' @return A numeric value giving the estimated distance cutoff value #' #' @examples #' irisDist <- dist(iris[,1:4]) #' estimateDc(irisDist) #' #' @references Rodriguez, A., & Laio, A. (2014). *Clustering by fast search and find of density peaks.* Science, **344**(6191), 1492-1496. doi:10.1126/science.1242072 #' #' @export #' estimateDc <- function(distance, neighborRateLow = 0.01, neighborRateHigh = 0.02) { # This implementation uses binary search instead of linear search. size <- attr(distance, 'Size') # If size is greater than 448, there will be >100000 elements in the distance # object. Subsampling to 100000 elements will speed performance for very # large dist objects while retaining good accuracy in estimating the cutoff if (size > 448) { distance <- distance[sample.int(length(distance), 100128)] size <- 448 } low <- min(distance) high <- max(distance) dc <- 0 while (TRUE) { dc <- (low + high) / 2 # neighborRate = average of number of elements of comb per row that are # less than dc minus 1 divided by size. # This implementation avoids converting `distance` to a matrix. The matrix is # symmetrical, so doubling the result from `distance` (half of the matrix) is # equivalent. The diagonal of the matrix will always be 0, so as long as dc # is greater than 0, we add 1 for every element of the diagonal, which is # the same as size neighborRate <- (((sum(distance < dc) * 2 + (if (0 <= dc) size)) / size - 1)) / size if (neighborRate >= neighborRateLow && neighborRate <= neighborRateHigh) break if (neighborRate < neighborRateLow) { low <- dc } else { high <- dc } } cat('Distance cutoff calculated to', dc, '\n') dc } #' Calculate clustering attributes based on the densityClust algorithm #' #' This function takes a distance matrix and optionally a distance cutoff and #' calculates the values necessary for clustering based on the algorithm #' proposed by Alex Rodrigues and Alessandro Laio (see references). The actual #' assignment to clusters are done in a later step, based on user defined #' threshold values. If a distance matrix is passed into `distance` the #' original algorithm described in the paper is used. If a matrix or data.frame #' is passed instead it is interpretted as point coordinates and rho will be #' estimated based on k-nearest neighbors of each point (rho is estimated as #' `exp(-mean(x))` where `x` is the distance to the nearest #' neighbors). This can be useful when data is so large that calculating the #' full distance matrix can be prohibitive. #' #' @details #' The function calculates rho and delta for the observations in the provided #' distance matrix. If a distance cutoff is not provided this is first estimated #' using [estimateDc()] with default values. #' #' The information kept in the densityCluster object is: #' \describe{ #' \item{`rho`}{A vector of local density values} #' \item{`delta`}{A vector of minimum distances to observations of higher density} #' \item{`distance`}{The initial distance matrix} #' \item{`dc`}{The distance cutoff used to calculate rho} #' \item{`threshold`}{A named vector specifying the threshold values for rho and delta used for cluster detection} #' \item{`peaks`}{A vector of indexes specifying the cluster center for each cluster} #' \item{`clusters`}{A vector of cluster affiliations for each observation. The clusters are referenced as indexes in the peaks vector} #' \item{`halo`}{A logical vector specifying for each observation if it is considered part of the halo} #' \item{`knn_graph`}{kNN graph constructed. It is only applicable to the case where coordinates are used as input. Currently it is set as NA.} #' \item{`nearest_higher_density_neighbor`}{index for the nearest sample with higher density. It is only applicable to the case where coordinates are used as input.} #' \item{`nn.index`}{indices for each cell's k-nearest neighbors. It is only applicable for the case where coordinates are used as input.} #' \item{`nn.dist`}{distance to each cell's k-nearest neighbors. It is only applicable for the case where coordinates are used as input.} #' } #' Before running findClusters the threshold, peaks, clusters and halo data is #' `NA`. #' #' @param distance A distance matrix or a matrix (or data.frame) for the #' coordinates of the data. If a matrix or data.frame is used the distances and #' local density will be estimated using a fast k-nearest neighbor approach. #' #' @param dc A distance cutoff for calculating the local density. If missing it #' will be estimated with `estimateDc(distance)` #' #' @param gaussian Logical. Should a gaussian kernel be used to estimate the #' density (defaults to FALSE) #' #' @param verbose Logical. Should the running details be reported #' #' @param ... Additional parameters passed on to [get.knn][FNN::get.knn] #' #' @return A densityCluster object. See details for a description. #' #' @examples #' irisDist <- dist(iris[,1:4]) #' irisClust <- densityClust(irisDist, gaussian=TRUE) #' plot(irisClust) # Inspect clustering attributes to define thresholds #' #' irisClust <- findClusters(irisClust, rho=2, delta=2) #' plotMDS(irisClust) #' split(iris[,5], irisClust$clusters) #' #' @seealso [estimateDc()], [findClusters()] #' #' @references Rodriguez, A., & Laio, A. (2014). *Clustering by fast search and find of density peaks.* Science, **344**(6191), 1492-1496. doi:10.1126/science.1242072 #' #' @export #' densityClust <- function(distance, dc, gaussian=FALSE, verbose = FALSE, ...) { if (is.data.frame(distance) || is.matrix(distance)) { dp_knn_args <- list(mat = distance, verbose = verbose, ...) res <- do.call(densityClust.knn, dp_knn_args) } else { if (missing(dc)) { if (verbose) message('Calculating the distance cutoff') dc <- estimateDc(distance) } if (verbose) message('Calculating the local density for each sample based on distance cutoff') rho <- localDensity(distance, dc, gaussian = gaussian) if (verbose) message('Calculating the minimal distance of a sample to another sample with higher density') delta <- distanceToPeak(distance, rho) if (verbose) message('Returning result...') res <- list( rho = rho, delta = delta, distance = distance, dc = dc, threshold = c(rho = NA, delta = NA), peaks = NA, clusters = NA, halo = NA, knn_graph = NA, nearest_higher_density_neighbor = NA, nn.index = NA, nn.dist = NA ) class(res) <- 'densityCluster' } res } #' @export #' @importFrom graphics plot points #' plot.densityCluster <- function(x, ...) { plot(x$rho, x$delta, main = 'Decision graph', xlab = expression(rho), ylab = expression(delta)) if (!is.na(x$peaks[1])) { points(x$rho[x$peaks], x$delta[x$peaks], col = 2:(1 + length(x$peaks)), pch = 19) } } #' Plot observations using multidimensional scaling and colour by cluster #' #' This function produces an MDS scatterplot based on the distance matrix of the #' densityCluster object (if there is only the coordinates information, a distance #' matrix will be calculate first), and, if clusters are defined, colours each #' observation according to cluster affiliation. Observations belonging to a cluster #' core is plotted with filled circles and observations belonging to the halo with #' hollow circles. This plotting is not suitable for running large datasets (for example #' datasets with > 1000 samples). Users are suggested to use other methods, for example #' tSNE, etc. to visualize their clustering results too. #' #' @param x A densityCluster object as produced by [densityClust()] #' #' @param ... Additional parameters. Currently ignored #' #' @examples #' irisDist <- dist(iris[,1:4]) #' irisClust <- densityClust(irisDist, gaussian=TRUE) #' plot(irisClust) # Inspect clustering attributes to define thresholds #' #' irisClust <- findClusters(irisClust, rho=2, delta=2) #' plotMDS(irisClust) #' split(iris[,5], irisClust$clusters) #' #' @seealso [densityClust()] for creating `densityCluster` #' objects, and [plotTSNE()] for an alternative plotting approach. #' #' @export #' plotMDS <- function(x, ...) { UseMethod('plotMDS') } #' @export #' @importFrom stats cmdscale #' @importFrom graphics plot points legend #' @importFrom stats dist plotMDS.densityCluster <- function(x, ...) { if (is.data.frame(x$distance) || is.matrix(x$distance)) { mds <- cmdscale(dist(x$distance)) } else { mds <- cmdscale(x$distance) } plot(mds[,1], mds[,2], xlab = '', ylab = '', main = 'MDS plot of observations') if (!is.na(x$peaks[1])) { for (i in 1:length(x$peaks)) { ind <- which(x$clusters == i) points(mds[ind, 1], mds[ind, 2], col = i + 1, pch = ifelse(x$halo[ind], 1, 19)) } legend('topright', legend = c('core', 'halo'), pch = c(19, 1), horiz = TRUE) } } #' Plot observations using t-distributed neighbor embedding and colour by cluster #' #' This function produces an t-SNE scatterplot based on the distance matrix of the #' densityCluster object (if there is only the coordinates information, a distance #' matrix will be calculate first), and, if clusters are defined, colours each #' observation according to cluster affiliation. Observations belonging to a cluster #' core is plotted with filled circles and observations belonging to the halo with #' hollow circles. #' #' @param x A densityCluster object as produced by [densityClust()] #' #' @param ... Additional parameters. Currently ignored #' #' @examples #' irisDist <- dist(iris[,1:4]) #' irisClust <- densityClust(irisDist, gaussian=TRUE) #' plot(irisClust) # Inspect clustering attributes to define thresholds #' #' irisClust <- findClusters(irisClust, rho=2, delta=2) #' plotTSNE(irisClust) #' split(iris[,5], irisClust$clusters) #' #' @seealso [densityClust()] for creating `densityCluster` #' objects, and [plotMDS()] for an alternative plotting approach. #' #' @export #' plotTSNE <- function(x, ...) { UseMethod('plotTSNE') } #' @export #' @importFrom graphics plot points legend #' @importFrom stats dist #' @importFrom stats rnorm #' @importFrom Rtsne Rtsne plotTSNE.densityCluster <- function(x, max_components = 2, ...) { if (is.data.frame(x$distance) || is.matrix(x$distance)) { data <- as.matrix(dist(x$distance)) } else { data <- as.matrix(x$distance) } # avoid issues related to repetitions dup_id <- which(duplicated(data)) if (length(dup_id) > 0) { data[dup_id, ] <- data[dup_id, ] + rnorm(length(dup_id) * ncol(data), sd = 1e-10) } tsne_res <- Rtsne::Rtsne(as.matrix(data), dims = max_components, pca = T) tsne_data <- tsne_res$Y[, 1:max_components] plot(tsne_data[,1], tsne_data[,2], xlab = '', ylab = '', main = 'tSNE plot of observations') if (!is.na(x$peaks[1])) { for (i in 1:length(x$peaks)) { ind <- which(x$clusters == i) points(tsne_data[ind, 1], tsne_data[ind, 2], col = i + 1, pch = ifelse(x$halo[ind], 1, 19)) } legend('topright', legend = c('core', 'halo'), pch = c(19, 1), horiz = TRUE) } } #' @export #' print.densityCluster <- function(x, ...) { if (is.na(x$peaks[1])) { cat('A densityCluster object with no clusters defined\n\n') cat('Number of observations:', length(x$rho), '\n') } else { cat('A densityCluster object with', length(x$peaks), 'clusters defined\n\n') cat('Number of observations:', length(x$rho), '\n') cat('Observations in core: ', sum(!x$halo), '\n\n') cat('Parameters:\n') cat('dc (distance cutoff) rho threshold delta threshold\n') cat(formatC(x$dc, width = -22), formatC(x$threshold[1], width = -22), x$threshold[2]) } } #' Detect clusters in a densityCluster obejct #' #' This function uses the supplied rho and delta thresholds to detect cluster #' peaks and assign the rest of the observations to one of these clusters. #' Furthermore core/halo status is calculated. If either rho or delta threshold #' is missing the user is presented with a decision plot where they are able to #' click on the plot area to set the treshold. If either rho or delta is set, #' this takes presedence over the value found by clicking. #' #' @param x A densityCluster object as produced by [densityClust()] #' #' @param ... Additional parameters passed on #' #' @return A densityCluster object with clusters assigned to all observations #' #' @examples #' irisDist <- dist(iris[,1:4]) #' irisClust <- densityClust(irisDist, gaussian=TRUE) #' plot(irisClust) # Inspect clustering attributes to define thresholds #' #' irisClust <- findClusters(irisClust, rho=2, delta=2) #' plotMDS(irisClust) #' split(iris[,5], irisClust$clusters) #' #' @references Rodriguez, A., & Laio, A. (2014). *Clustering by fast search and find of density peaks.* Science, **344**(6191), 1492-1496. doi:10.1126/science.1242072 #' #' @export #' findClusters <- function(x, ...) { UseMethod("findClusters") } #' @rdname findClusters #' #' @param rho The threshold for local density when detecting cluster peaks #' #' @param delta The threshold for minimum distance to higher density when detecting cluster peaks #' #' @param plot Logical. Should a decision plot be shown after cluster detection #' #' @param peaks A numeric vector indicates the index of density peaks used for clustering. This vector should be retrieved from the decision plot with caution. No checking involved. #' #' @param verbose Logical. Should the running details be reported #' #' @export #' @importFrom graphics plot locator findClusters.densityCluster <- function(x, rho, delta, plot = FALSE, peaks = NULL, verbose = FALSE, ...) { if (is.data.frame(x$distance) || is.matrix(x$distance)) { peak_ind <- which(x$rho > rho & x$delta > delta) x$peaks <- peak_ind # Assign observations to clusters runOrder <- order(x$rho, decreasing = TRUE) cluster <- rep(NA, length(x$rho)) for (i in x$peaks) { cluster[i] <- match(i, x$peaks) } for (ind in setdiff(runOrder, x$peaks)) { target_lower_density_samples <- which(x$nearest_higher_density_neighbor == ind) #all the target cells should have the same cluster id as current higher density cell cluster[ind] <- cluster[x$nearest_higher_density_neighbor[ind]] } potential_duplicates <- which(is.na(cluster)) for (ind in potential_duplicates) { res <- as.integer(names(which.max(table(cluster[x$nn.index[ind, ]])))) if (length(res) > 0) { cluster[ind] <- res #assign NA samples to the majority of its clusters } else { message('try to increase the number of kNN (through argument k) at step of densityClust.') cluster[ind] <- NA } } x$clusters <- factor(cluster) # Calculate core/halo status of observation border <- rep(0, length(x$peaks)) if (verbose) message('Identifying core and halo for each cluster') for (i in 1:length(x$peaks)) { if (verbose) message('the current index of the peak is ', i) connect_samples_ind <- intersect(unique(x$nn.index[cluster == i, ]), which(cluster != i)) averageRho <- outer(x$rho[cluster == i], x$rho[connect_samples_ind], '+') / 2 if (any(connect_samples_ind)) border[i] <- max(averageRho[connect_samples_ind]) } x$halo <- x$rho < border[cluster] x$threshold['rho'] <- rho x$threshold['delta'] <- delta } else { # Detect cluster peaks if (!is.null(peaks)) { if (verbose) message('peaks are provided, clustering will be performed based on them') x$peaks <- peaks } else { if (missing(rho) || missing(delta)) { x$peaks <- NA plot(x) cat('Click on plot to select thresholds\n') threshold <- locator(1) if (missing(rho)) rho <- threshold$x if (missing(delta)) delta <- threshold$y plot = TRUE } x$peaks <- which(x$rho > rho & x$delta > delta) x$threshold['rho'] <- rho x$threshold['delta'] <- delta } if (plot) { plot(x) } # Assign observations to clusters runOrder <- order(x$rho, decreasing = TRUE) cluster <- rep(NA, length(x$rho)) if (verbose) message('Assigning each sample to a cluster based on its nearest density peak') for (i in runOrder) { if ((i %% round(length(runOrder) / 25)) == 0) { if (verbose) message(paste('the runOrder index is', i)) } if (i %in% x$peaks) { cluster[i] <- match(i, x$peaks) } else { higherDensity <- which(x$rho > x$rho[i]) cluster[i] <- cluster[higherDensity[which.min(findDistValueByRowColInd(as.numeric(x$distance), as.integer(attr(x$distance, 'Size')), i, higherDensity))]] } } x$clusters <- cluster # Calculate core/halo status of observation border <- rep(0, length(x$peaks)) if (verbose) message('Identifying core and halo for each cluster') for (i in 1:length(x$peaks)) { if (verbose) message('the current index of the peak is ', i) averageRho <- outer(x$rho[cluster == i], x$rho[cluster != i], '+')/2 index <- findDistValueByRowColInd(as.numeric(x$distance), as.integer(attr(x$distance, 'Size')), which(cluster == i), which(cluster != i)) <= x$dc if (any(index)) border[i] <- max(averageRho[index]) } x$halo <- x$rho < border[cluster] } x$halo <- x$rho < border[cluster] # Sort cluster designations by gamma (= rho * delta) gamma <- x$rho * x$delta pk.ordr <- order(gamma[x$peaks], decreasing = TRUE) x$peaks <- x$peaks[pk.ordr] x$clusters <- match(x$clusters, pk.ordr) x } #' Extract cluster membership from a densityCluster object #' #' This function allows the user to extract the cluster membership of all the #' observations in the given densityCluster object. The output can be formatted #' in two ways as described below. Halo observations can be chosen to be removed #' from the output. #' #' @details #' Two formats for the output are available. Either a vector of integers #' denoting for each observation, which cluster the observation belongs to. If #' halo observations are removed, these are set to NA. The second format is a #' list with a vector for each group containing the index for the member #' observations in the group. If halo observations are removed their indexes are #' omitted. The list format correspond to the following transform of the vector #' format `split(1:length(clusters), clusters)`, where `clusters` are #' the cluster information in vector format. #' #' @param x The densityCluster object. [findClusters()] must have #' been performed prior to this call to avoid throwing an error. #' #' @param ... Currently ignored #' #' @return A vector or list with cluster memberships for the observations in the #' initial distance matrix #' #' @export #' clusters <- function(x, ...) { UseMethod("clusters") } #' @rdname clusters #' #' @param as.list Should the output be in the list format. Defaults to FALSE #' #' @param halo.rm Logical. should halo observations be removed. Defaults to TRUE #' #' @export #' clusters.densityCluster <- function(x, as.list = FALSE, halo.rm = TRUE, ...) { if (!clustered(x)) stop('x must be clustered prior to cluster extraction') res <- x$clusters if (halo.rm) { res[x$halo] <- NA } if (as.list) { res <- split(1:length(res), res) } res } #' Check whether a densityCluster object have been clustered #' #' This function checks whether [findClusters()] has been performed on #' the given object and returns a boolean depending on the outcome #' #' @param x A densityCluster object #' #' @return `TRUE` if [findClusters()] have been performed, otherwise #' `FALSE` #' #' @export #' clustered <- function(x) { UseMethod("clustered") } #' @rdname clustered #' #' @export #' clustered.densityCluster <- function(x) { !any(is.na(x$peaks[1]), is.na(x$clusters[1]), is.na(x$halo[1])) } #' Extract labels #' #' @noRd #' #' @export #' labels.densityCluster <- function(object, ...) { labels(object$distance) } #' Fast knn version of densityClust #' #' This function will be called by densityClust if a matrix or data.frame is #' passed in rather than a distance object #' #' @noRd #' #' @importFrom FNN get.knn densityClust.knn <- function(mat, k = NULL, verbose = F, ...) { if (is.null(k)) { k <- round(sqrt(nrow(mat)) / 2) # empirical way to select the number of neighbor points k <- max(10, k) # ensure k is at least 10 } if (verbose) message('Finding kNN using FNN with ', k, ' neighbors') dx <- get.knn(mat, k = k, ...) nn.index <- dx$nn.index nn.dist <- dx$nn.dist N <- nrow(nn.index) knn_graph <- NULL if (verbose) message('Calculating the local density for each sample based on kNNs ...') rho <- apply(nn.dist, 1, function(x) { exp(-mean(x)) }) if (verbose) message('Calculating the minimal distance of a sample to another sample with higher density ...') rho_order <- order(rho) delta <- vector(mode = 'integer', length = N) nearest_higher_density_neighbor <- vector(mode = 'integer', length = N) delta_neighbor_tmp <- smallest_dist_rho_order_coords(rho[rho_order], as.matrix(mat[rho_order, ])) delta[rho_order] <- delta_neighbor_tmp$smallest_dist nearest_higher_density_neighbor[rho_order] <- rho_order[delta_neighbor_tmp$nearest_higher_density_sample + 1] if (verbose) message('Returning result...') res <- list( rho = rho, delta = delta, distance = mat, dc = NULL, threshold = c(rho = NA, delta = NA), peaks = NA, clusters = NA, halo = NA, knn_graph = knn_graph, nearest_higher_density_neighbor = nearest_higher_density_neighbor, nn.index = nn.index, nn.dist = nn.dist ) class(res) <- 'densityCluster' res } densityClust/NEWS.md0000644000176200001440000000047214471076225014055 0ustar liggesusers# densityClust 0.3.3 * Upkeep * Move from Rcpp to cpp11 # densityClust 0.3.2 * Fix more if clauses that could lead to a logical vector instead of a scalar # densityClust 0.3.1 * Added a `NEWS.md` file to track changes to the package. * Fix an if clause that could lead to a logical vector instead of a scalar densityClust/MD50000644000176200001440000000265614555733152013277 0ustar liggesusers16a3438ceb2bb3c9274755a29c8cbb59 *DESCRIPTION f48a53a7c67acf786d5f75fdc6d2e9e1 *NAMESPACE 621aecf4f10789d7558967710b2a6ea9 *NEWS.md 229dead3fa9c321a028812fe82b5c1d8 *R/cpp11.R 9341646afce4ddba7a3c1471c531ac0e *R/densityClust-package.R aa75c9363572b75dad59d2ab14ed48d0 *R/densityClust.R 630a945038bf37962f37efcc07b99108 *R/plotDensityClust.R 3ffc773507d91422a72e3934715e090d *README.md 42be68192407d5489d6a2b74f7040922 *man/clustered.Rd 082efd30afc73ebd651d4492c2159e84 *man/clusters.Rd 5381b1a2d489f4813cf72b7b7d31e650 *man/densityClust-package.Rd 711ae585690ba33eaffde4bebd17de7a *man/densityClust.Rd 4dd8395b14598aa5a338ff6d83bcbe80 *man/estimateDc.Rd 037fdbe756fd7976ba196a25d24885da *man/figures/README-unnamed-chunk-2-1.png ef61849be7f99b63bc19a6d1c14e5b96 *man/figures/README-unnamed-chunk-2-2.png 7e67ae03d9932d46611c722e4b921d44 *man/findClusters.Rd f03e77aa6190e4de1ef681836ccce1f3 *man/plotDensityClust.Rd 16ac60de9a02992eb1673d6ffe9d333a *man/plotMDS.Rd 91b2473f7511045df290d8c8be1d1236 *man/plotTSNE.Rd fd06297ec5c34cbca919680472bf2116 *src/cpp11.cpp b613108c2aa6e36efbe7edeecd62268e *src/distanceToPeak.cpp 83d08897bc7da8e9b0584ee4a4eb9bfe *src/findDistValueByRowColInd.cpp f2464f7ae3078f8a2a70e456b2e1859c *src/localDensity.cpp 45a9550a0d9fb5e170e463c3c03a7f5b *tests/testthat.R f8e7596ac614b2ab51c1fc76d8e233f0 *tests/testthat/generateReference.R 2f4d5bb1af4dbbd0bb3911d0587dbedd *tests/testthat/testEquivalenceToReferenceImplementation.R