X-Git-Url: https://git.auder.net/?p=valse.git;a=blobdiff_plain;f=pkg%2Ftests%2Ftestthat%2Fhelper-clustering.R;fp=pkg%2Ftests%2Ftestthat%2Fhelper-clustering.R;h=785b7f02af289cf50d3bddc9ab3ea51e70c1b886;hp=0000000000000000000000000000000000000000;hb=5ce95f263665997e5319422d19ac2ad9635b1e58;hpb=31444abc970b7fe17463bcc916e95846272158db

diff --git a/pkg/tests/testthat/helper-clustering.R b/pkg/tests/testthat/helper-clustering.R
new file mode 100644
index 0000000..785b7f0
--- /dev/null
+++ b/pkg/tests/testthat/helper-clustering.R
@@ -0,0 +1,11 @@
+# Compute the sum of (normalized) sum of squares of closest distances to a medoid.
+computeDistortion <- function(series, medoids)
+{
+	n <- ncol(series)
+	L <- nrow(series)
+	distortion <- 0.
+	for (i in seq_len(n))
+		distortion <- distortion + min( colSums( sweep(medoids,1,series[,i],'-')^2 ) / L )
+
+	sqrt( distortion / n )
+}