svf-tools 1.0.285 → 1.0.286

package/lib/FastCluster/fastcluster.cpp

@@ -0,0 +1,170 @@
+//
+// C++ standalone verion of fastcluster by Daniel Müllner
+//
+// Copyright: Christoph Dalitz, 2020
+//            Daniel Müllner, 2011
+// License:   BSD style license
+//            (see the file LICENSE for details)
+//
+
+
+#include <assert.h>
+#include <vector>
+#include <algorithm>
+
+#include "FastCluster/fastcluster.h"
+
+// Code by Daniel Müllner
+// workaround to make it usable as a standalone version (without R)
+bool fc_isnan(double x) { return false; }
+#include "fastcluster_dm.cpp.inc"
+#include "fastcluster_R_dm.cpp.inc"
+
+//
+// Assigns cluster labels (0, ..., nclust-1) to the n points such
+// that the cluster result is split into nclust clusters.
+//
+// Input arguments:
+//   n      = number of observables
+//   merge  = clustering result in R format
+//   nclust = number of clusters
+// Output arguments:
+//   labels = allocated integer array of size n for result
+//
+void cutree_k(int n, const int* merge, int nclust, int* labels) {
+
+  int k,m1,m2,j,l;
+
+  if (nclust > n || nclust < 2) {
+    for (j=0; j<n; j++) labels[j] = 0;
+    return;
+  }
+
+  // assign to each observable the number of its last merge step
+  // beware: indices of observables in merge start at 1 (R convention)
+  std::vector<int> last_merge(n, 0);
+  for (k=1; k<=(n-nclust); k++) {
+    // (m1,m2) = merge[k,]
+    m1 = merge[k-1];
+    m2 = merge[n-1+k-1];
+    if (m1 < 0 && m2 < 0) { // both single observables
+      last_merge[-m1-1] = last_merge[-m2-1] = k;
+	}
+	else if (m1 < 0 || m2 < 0) { // one is a cluster
+	    if(m1 < 0) { j = -m1; m1 = m2; } else j = -m2;
+	    // merging single observable and cluster
+	    for(l = 0; l < n; l++)
+		if (last_merge[l] == m1)
+		    last_merge[l] = k;
+	    last_merge[j-1] = k;
+	}
+	else { // both cluster
+	    for(l=0; l < n; l++) {
+		if( last_merge[l] == m1 || last_merge[l] == m2 )
+		    last_merge[l] = k;
+	    }
+    }
+  }
+
+  // assign cluster labels
+  int label = 0;
+  std::vector<int> z(n,-1);
+  for (j=0; j<n; j++) {
+    if (last_merge[j] == 0) { // still singleton
+      labels[j] = label++;
+    } else {
+      if (z[last_merge[j]] < 0) {
+        z[last_merge[j]] = label++;
+      }
+      labels[j] = z[last_merge[j]];
+    }
+  }
+}
+
+//
+// Assigns cluster labels (0, ..., nclust-1) to the n points such
+// that the hierarchical clustering is stopped when cluster distance >= cdist
+//
+// Input arguments:
+//   n      = number of observables
+//   merge  = clustering result in R format
+//   height = cluster distance at each merge step
+//   cdist  = cutoff cluster distance
+// Output arguments:
+//   labels = allocated integer array of size n for result
+//
+void cutree_cdist(int n, const int* merge, double* height, double cdist, int* labels) {
+
+  int k;
+
+  for (k=0; k<(n-1); k++) {
+    if (height[k] >= cdist) {
+      break;
+    }
+  }
+  cutree_k(n, merge, n-k, labels);
+}
+
+
+//
+// Hierarchical clustering with one of Daniel Muellner's fast algorithms
+//
+// Input arguments:
+//   n       = number of observables
+//   distmat = condensed distance matrix, i.e. an n*(n-1)/2 array representing
+//             the upper triangle (without diagonal elements) of the distance
+//             matrix, e.g. for n=4:
+//               d00 d01 d02 d03
+//               d10 d11 d12 d13   ->  d01 d02 d03 d12 d13 d23
+//               d20 d21 d22 d23
+//               d30 d31 d32 d33
+//   method  = cluster metric (see enum hclust_fast_methods)
+// Output arguments:
+//   merge   = allocated (n-1)x2 matrix (2*(n-1) array) for storing result.
+//             Result follows R hclust convention:
+//              - observabe indices start with one
+//              - merge[i][] contains the merged nodes in step i
+//              - merge[i][j] is negative when the node is an atom
+//   height  = allocated (n-1) array with distances at each merge step
+// Return code:
+//   0 = ok
+//   1 = invalid method
+//
+int hclust_fast(int n, double* distmat, int method, int* merge, double* height) {
+  
+  // call appropriate culstering function
+  cluster_result Z2(n-1);
+  if (method == HCLUST_METHOD_SINGLE) {
+    // single link
+    MST_linkage_core(n, distmat, Z2);
+  }
+  else if (method == HCLUST_METHOD_COMPLETE) {
+    // complete link
+    NN_chain_core<METHOD_METR_COMPLETE, t_float>(n, distmat, NULL, Z2);
+  }
+  else if (method == HCLUST_METHOD_AVERAGE) {
+    // best average distance
+    double* members = new double[n];
+    for (int i=0; i<n; i++) members[i] = 1;
+    NN_chain_core<METHOD_METR_AVERAGE, t_float>(n, distmat, members, Z2);
+    delete[] members;
+  }
+  else if (method == HCLUST_METHOD_MEDIAN) {
+    // best median distance (beware: O(n^3))
+    generic_linkage<METHOD_METR_MEDIAN, t_float>(n, distmat, NULL, Z2);
+  }
+  else {
+    return 1;
+  }
+  
+  int* order = new int[n];
+  if (method == HCLUST_METHOD_MEDIAN) {
+    generate_R_dendrogram<true>(merge, height, order, Z2, n);
+  } else {
+    generate_R_dendrogram<false>(merge, height, order, Z2, n);
+  }
+
+  delete[] order; // only needed for visualization
+  
+  return 0;
+}

package/lib/FastCluster/fastcluster_R_dm.cpp.inc

@@ -0,0 +1,115 @@
+//
+// Excerpt from fastcluster_R.cpp
+//
+// Copyright: Daniel Müllner, 2011 <http://danifold.net>
+//
+
+struct pos_node {
+  t_index pos;
+  int node;
+};
+
+void order_nodes(const int N, const int * const merge, const t_index * const node_size, int * const order) {
+  /* Parameters:
+     N         : number of data points
+     merge     : (N-1)×2 array which specifies the node indices which are
+                 merged in each step of the clustering procedure.
+                 Negative entries -1...-N point to singleton nodes, while
+                 positive entries 1...(N-1) point to nodes which are themselves
+                 parents of other nodes.
+     node_size : array of node sizes - makes it easier
+     order     : output array of size N
+
+     Runtime: Θ(N)
+  */
+  auto_array_ptr<pos_node> queue(N/2);
+
+  int parent;
+  int child;
+  t_index pos = 0;
+
+  queue[0].pos = 0;
+  queue[0].node = N-2;
+  t_index idx = 1;
+
+  do {
+    --idx;
+    pos = queue[idx].pos;
+    parent = queue[idx].node;
+
+    // First child
+    child = merge[parent];
+    if (child<0) { // singleton node, write this into the 'order' array.
+      order[pos] = -child;
+      ++pos;
+    }
+    else { /* compound node: put it on top of the queue and decompose it
+              in a later iteration. */
+      queue[idx].pos = pos;
+      queue[idx].node = child-1; // convert index-1 based to index-0 based
+      ++idx;
+      pos += node_size[child-1];
+    }
+    // Second child
+    child = merge[parent+N-1];
+    if (child<0) {
+      order[pos] = -child;
+    }
+    else {
+      queue[idx].pos = pos;
+      queue[idx].node = child-1;
+      ++idx;
+    }
+  } while (idx>0);
+}
+
+#define size_(r_) ( ((r_<N) ? 1 : node_size[r_-N]) )
+
+template <const bool sorted>
+void generate_R_dendrogram(int * const merge, double * const height, int * const order, cluster_result & Z2, const int N) {
+  // The array "nodes" is a union-find data structure for the cluster
+  // identites (only needed for unsorted cluster_result input).
+  union_find nodes(sorted ? 0 : N);
+  if (!sorted) {
+    std::stable_sort(Z2[0], Z2[N-1]);
+  }
+
+  t_index node1, node2;
+  auto_array_ptr<t_index> node_size(N-1);
+
+  for (t_index i=0; i<N-1; ++i) {
+    // Get two data points whose clusters are merged in step i.
+    // Find the cluster identifiers for these points.
+    if (sorted) {
+      node1 = Z2[i]->node1;
+      node2 = Z2[i]->node2;
+    }
+    else {
+      node1 = nodes.Find(Z2[i]->node1);
+      node2 = nodes.Find(Z2[i]->node2);
+      // Merge the nodes in the union-find data structure by making them
+      // children of a new node.
+      nodes.Union(node1, node2);
+    }
+    // Sort the nodes in the output array.
+    if (node1>node2) {
+      t_index tmp = node1;
+      node1 = node2;
+      node2 = tmp;
+    }
+    /* Conversion between labeling conventions.
+       Input:  singleton nodes 0,...,N-1
+               compound nodes  N,...,2N-2
+       Output: singleton nodes -1,...,-N
+               compound nodes  1,...,N
+    */
+    merge[i]     = (node1<N) ? -static_cast<int>(node1)-1
+                              : static_cast<int>(node1)-N+1;
+    merge[i+N-1] = (node2<N) ? -static_cast<int>(node2)-1
+                              : static_cast<int>(node2)-N+1;
+    height[i] = Z2[i]->dist;
+    node_size[i] = size_(node1) + size_(node2);
+  }
+
+  order_nodes(N, merge, node_size, order);
+}