Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
S
shiny-timecourse-inspector
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
2
Issues
2
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
pertz-lab
shiny-timecourse-inspector
Commits
a5ad4d34
Commit
a5ad4d34
authored
Oct 06, 2019
by
dmattek
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Removed Marc's custom factoextra functions
parent
56c778e5
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
0 additions
and
100 deletions
+0
-100
modules/auxfunc.R
modules/auxfunc.R
+0
-100
No files found.
modules/auxfunc.R
View file @
a5ad4d34
...
...
@@ -597,106 +597,6 @@ getClCol <- function(in.dend, in.k) {
))
}
# Cluster validation ----
#Customize factoextra functions to accept dissimilarity matrix from start. Otherwise can't use distance functions that are not in base R, like DTW.
# Inherit and adapt hcut function to take input from UI, used for fviz_clust
LOChcut
<-
function
(
x
,
k
=
2
,
isdiss
=
inherits
(
x
,
"dist"
),
hc_func
=
"hclust"
,
hc_method
=
"average"
,
hc_metric
=
"euclidean"
)
{
if
(
!
inherits
(
x
,
"dist"
))
{
stop
(
"x must be a distance matrix"
)
}
return
(
factoextra
::
hcut
(
x
=
x
,
k
=
k
,
isdiss
=
TRUE
,
hc_func
=
hc_func
,
hc_method
=
hc_method
,
hc_metric
=
hc_metric
)
)
}
# Modified from factoextra::fviz_nbclust
# Allow (actually enforce) x to be a distance matrix; no GAP statistics for compatibility
LOCnbclust
<-
function
(
x
,
FUNcluster
=
LOChcut
,
method
=
c
(
"silhouette"
,
"wss"
),
k.max
=
10
,
verbose
=
FALSE
,
barfill
=
"steelblue"
,
barcolor
=
"steelblue"
,
linecolor
=
"steelblue"
,
print.summary
=
TRUE
,
...
)
{
set.seed
(
123
)
if
(
k.max
<
2
)
stop
(
"k.max must bet > = 2"
)
method
=
match.arg
(
method
)
if
(
!
inherits
(
x
,
c
(
"dist"
)))
stop
(
"x should be an object of class dist"
)
else
if
(
is.null
(
FUNcluster
))
stop
(
"The argument FUNcluster is required. "
,
"Possible values are kmeans, pam, hcut, clara, ..."
)
else
if
(
method
%in%
c
(
"silhouette"
,
"wss"
))
{
diss
<-
x
# x IS ENFORCED TO BE A DISSIMILARITY MATRIX
v
<-
rep
(
0
,
k.max
)
if
(
method
==
"silhouette"
)
{
loc.mainlab
=
"Optimal number of clusters from silhouette analysis"
loc.ylab
<-
"Average silhouette width"
for
(
i
in
2
:
k.max
)
{
clust
<-
FUNcluster
(
x
,
i
,
...
)
v
[
i
]
<-
factoextra
:::
.get_ave_sil_width
(
diss
,
clust
$
cluster
)
}
}
else
if
(
method
==
"wss"
)
{
loc.mainlab
=
"Optimal number of clusters from within cluster sum of squares"
loc.ylab
<-
"Total within cluster sum of squares"
for
(
i
in
1
:
k.max
)
{
clust
<-
FUNcluster
(
x
,
i
,
...
)
v
[
i
]
<-
factoextra
:::
.get_withinSS
(
diss
,
clust
$
cluster
)
}
}
df
<-
data.frame
(
clusters
=
as.factor
(
1
:
k.max
),
y
=
v
)
p
<-
ggpubr
::
ggline
(
df
,
x
=
"clusters"
,
y
=
"y"
,
group
=
1
,
color
=
linecolor
,
ylab
=
loc.ylab
,
xlab
=
"Number of clusters"
,
main
=
loc.mainlab
)
if
(
method
==
"silhouette"
)
p
<-
p
+
geom_vline
(
xintercept
=
which.max
(
v
),
linetype
=
2
,
color
=
linecolor
)
return
(
p
)
}
}
# Custom plotting functions ----
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment