phynotype is an R package for clustering workflows,
consensus meta-clustering, validation, exploration, prediction, and
plotting.
phynotype is not on CRAN yet. Install the development
version from GitHub:
# install.packages("pak")
pak::pkg_install("ielbadisy/phynotype")library(phynotype)
fit <- cluster(iris[, 1:4], method = "kmeans", k = 3, seed = 1)
fit
#> <cluster_fit>
#> Method: kmeans
#> Observations: 150
#> Clusters: 3
summary(fit)
#> Cluster fit summary
#> Method: kmeans
#> Observations: 150
#> Clusters: 3
#> Sizes: 1=62, 2=38, 3=50The main objects expose a common accessor API, so downstream code does not need to inspect object internals.
method_used(fit)
#> [1] "kmeans"
n_clusters(fit)
#> [1] 3
data.frame(cluster = names(sizes(fit)), size = unname(sizes(fit)))
#> cluster size
#> 1 1 62
#> 2 2 38
#> 3 3 50
head(clusters(fit))
#> [1] 3 3 3 3 3 3
centers(fit)
#> Sepal.Length Sepal.Width Petal.Length Petal.Width
#> 1 0.05828 -0.30890 0.6355 0.2345
#> 2 1.00700 0.01635 1.9840 0.8717
#> 3 -0.83730 0.37070 -2.2960 -0.9533mfit <- metacluster(
iris[, 1:4],
methods = c("kmeans", "pam", "hclust"),
k = 2:5,
consensus = "coassoc",
seed = 1
)
mfit
#> <metacluster_fit>
#> Methods: kmeans, pam, hclust
#> Candidate fits: 12
#> Final clusters: 5
summary(mfit)
#> Meta-cluster summary
#> Methods: kmeans, pam, hclust
#> Candidate fits: 12
#> Final clusters: 5
#> Sizes: 1=50, 2=37, 3=28, 4=23, 5=12Inspect the candidate solutions, consensus selection, and co-association matrix:
head(mfit$candidate_table)
#> candidate method k n_clusters
#> 1 1 kmeans 2 2
#> 2 2 kmeans 3 3
#> 3 3 kmeans 4 4
#> 4 4 kmeans 5 5
#> 5 5 pam 2 2
#> 6 6 pam 3 3
mfit$selection_summary
#> k silhouette
#> 1 2 0.6567
#> 2 3 0.7659
#> 3 4 0.8603
#> 4 5 0.9076
mfit$stability_summary
#> metric mean_agreement min_agreement max_agreement
#> 1 pairwise_partition_agreement 0.8186 0.6761 1
round(mfit$coassoc_matrix[1:6, 1:6], 2)
#> [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,] 1.00 1.00 1.00 1.00 1.00 0.92
#> [2,] 1.00 1.00 1.00 1.00 1.00 0.92
#> [3,] 1.00 1.00 1.00 1.00 1.00 0.92
#> [4,] 1.00 1.00 1.00 1.00 1.00 0.92
#> [5,] 1.00 1.00 1.00 1.00 1.00 0.92
#> [6,] 0.92 0.92 0.92 0.92 0.92 1.00validate(fit)
#> <cluster_validation>
#> Object type: cluster_fit
#> Metrics: 5
#> metric value scale direction
#> silhouette 0.5528 -1 to 1 higher is better
#> calinski_harabasz 561.6 positive, unbounded higher is better
#> davies_bouldin 0.662 positive, unbounded lower is better
#> total_within 78.85 positive, unbounded lower is better
#> bootstrap_ari 0.971 <NA> <NA>
validate(mfit)
#> <cluster_validation>
#> Object type: metacluster_fit
#> Metrics: 4
#> metric value scale direction
#> silhouette 0.4926 -1 to 1 higher is better
#> calinski_harabasz 494.1 positive, unbounded higher is better
#> davies_bouldin 0.8168 positive, unbounded lower is better
#> pairwise_partition_agreement 0.8186 <NA> <NA>
validate(iris[, 1:4], method = "kmeans", k = 2:6, seed = 1)
#> <cluster_validation>
#> Object type: validation_grid
#> Metrics: 25
#> metric value scale direction k
#> silhouette 0.681 -1 to 1 higher is better 2
#> calinski_harabasz 513.9 positive, unbounded higher is better 2
#> davies_bouldin 0.4043 positive, unbounded lower is better 2
#> total_within 152.3 positive, unbounded lower is better 2
#> bootstrap_ari 0.9973 <NA> <NA> 2
#> silhouette 0.5528 -1 to 1 higher is better 3
#> calinski_harabasz 561.6 positive, unbounded higher is better 3
#> davies_bouldin 0.662 positive, unbounded lower is better 3
#> total_within 78.85 positive, unbounded lower is better 3
#> bootstrap_ari 0.971 <NA> <NA> 3
#> silhouette 0.4981 -1 to 1 higher is better 4
#> calinski_harabasz 530.8 positive, unbounded higher is better 4
#> davies_bouldin 0.7803 positive, unbounded lower is better 4
#> total_within 57.23 positive, unbounded lower is better 4
#> bootstrap_ari 0.9052 <NA> <NA> 4
#> silhouette 0.4912 -1 to 1 higher is better 5
#> calinski_harabasz 495.4 positive, unbounded higher is better 5
#> davies_bouldin 0.816 positive, unbounded lower is better 5
#> total_within 46.46 positive, unbounded lower is better 5
#> bootstrap_ari 0.9219 <NA> <NA> 5
#> silhouette 0.3648 -1 to 1 higher is better 6
#> calinski_harabasz 473.9 positive, unbounded higher is better 6
#> davies_bouldin 0.9142 positive, unbounded lower is better 6
#> total_within 39.04 positive, unbounded lower is better 6
#> bootstrap_ari 0.8684 <NA> <NA> 6exp <- explore(fit)
exp
#> <cluster_explore>
#> Rows in feature summary: 12
head(exp$feature_summary)
#> cluster feature mean sd median min max
#> 1 1 Sepal.Length 5.902 0.4664 5.9 4.9 7.0
#> 2 1 Sepal.Width 2.748 0.2963 2.8 2.0 3.4
#> 3 1 Petal.Length 4.394 0.5089 4.5 3.0 5.1
#> 4 1 Petal.Width 1.434 0.2975 1.4 1.0 2.4
#> 5 2 Sepal.Length 6.850 0.4942 6.7 6.1 7.9
#> 6 2 Sepal.Width 3.074 0.2901 3.0 2.5 3.8plot_clusters(fit)
plot_silhouette(fit)
plot_consensus(mfit)
plot_coassoc(mfit)
plot_feature_profiles(explore(fit))
plot_cluster_sizes(fit)
plot_biplot(fit)
pred <- predict(fit, iris[1:10, 1:4])
pred
#> <cluster_prediction>
#> Method: kmeans
#> Predictions: 10
data.frame(
observation = seq_along(pred$clusters),
cluster = pred$clusters
)
#> observation cluster
#> 1 1 3
#> 2 2 3
#> 3 3 3
#> 4 4 3
#> 5 5 3
#> 6 6 3
#> 7 7 3
#> 8 8 3
#> 9 9 3
#> 10 10 3Global permutation importance estimates which features the fitted clustering rule relies on most.
imp <- feature_importance(fit, n_repeats = 3, seed = 1)
imp
#> <feature_importance>
#> Metric: instability
#> Features: 4
#> Repeats: 3
imp$summary
#> feature importance std_error n_repeats
#> 1 Petal.Length 0.53330 0.007698 3
#> 2 Sepal.Length 0.08222 0.005879 3
#> 3 Petal.Width 0.04667 0.013880 3
#> 4 Sepal.Width 0.01111 0.005879 3plot(imp)
Ceteris paribus profiles show how local predictions change when one feature is varied and the other features are held fixed.
cp <- ceteris_paribus(
fit,
iris[1:2, 1:4],
features = c("Petal.Length", "Petal.Width"),
grid_size = 6,
target = "score"
)
cp
#> <ceteris_paribus>
#> Target: score
#> Profiles: 24
head(cp$profiles)
#> observation feature feature_value target cluster value observed_value
#> 1 1 Petal.Length 1.000 score 3 0.6160 1.4
#> 2 1 Petal.Length 1.500 score 3 0.5688 1.4
#> 3 1 Petal.Length 3.900 score 3 0.3362 1.4
#> 4 1 Petal.Length 4.653 score 3 0.2714 1.4
#> 5 1 Petal.Length 5.360 score 3 0.2177 1.4
#> 6 1 Petal.Length 6.900 score 3 0.1273 1.4
#> baseline_value baseline_cluster
#> 1 0.516 3
#> 2 0.516 3
#> 3 0.516 3
#> 4 0.516 3
#> 5 0.516 3
#> 6 0.516 3plot(cp)
LIME-style explanations fit local surrogate models around selected observations.
lx <- lime_explain(
fit,
iris[1:2, 1:4],
n_features = 3,
n_permutations = 50,
seed = 1
)
lx
#> <lime_explanation>
#> Target: cluster
#> Observations: 2
#> Effects: 6
lx$explanations
#> observation cluster target feature estimate absolute_effect direction
#> 1 1 3 cluster Petal.Length -0.19820 0.19820 negative
#> 2 1 3 cluster Petal.Width -0.09874 0.09874 negative
#> 3 1 3 cluster Sepal.Length -0.01558 0.01558 negative
#> 4 2 3 cluster Petal.Length -0.19690 0.19690 negative
#> 5 2 3 cluster Sepal.Length -0.10440 0.10440 negative
#> 6 2 3 cluster Petal.Width -0.06265 0.06265 negative
#> rank
#> 1 1
#> 2 2
#> 3 3
#> 4 1
#> 5 2
#> 6 3plot(lx)