Aidan Lakshman's R Blog

The ExoLabel Post: Clustering Massive Networks with Limited Resources

2025-04-11T00:00:00-04:00

I’ve made a lot of posts about ExoLabel, but the project has been moving so quickly that they’ve become out of date almost as soon as I post them. I’m finally close to the end of this project, so I thought it was high time I write out the entire project (partly for my own reference, so I don’t forget).

The Problem

ExoLabel is an algorithm to cluster big networks, but…why would anyone want to do that?

There’s a lot of use-cases for network clustering (also sometimes referred to as community detection for graphs/networks), but our specific need came from a a problem we encountered in our workflow.

You may be shocked to learn that the field of comparative genomics revolves around being able to compare genomic data. This assumes we have an answer to a critical foundational question: how do we know what genomic data are comparable? Typically, genomic analyses are performed on “related” genes. For phylogenetic reconstruction, this would be groups of genes we assume derived from a common ancestor. The notion of genes being related is a little tricky to define, but a lot of it stems from genes that have similarity in their sequence.

We can get a measure of how similar sequences are by using tools for pairwise sequence similarity comparisons, like BLAST or DIAMOND. This gets us part of the way to a solution, but natural evolutionary processes introduce a lot of noise into the data we analyze. This means that truly related genes could appear to have low similarity, and unrelated genes could spuriously appear to be very similar.

One approach to get around this is to cluster the network formed by these genes when we connect them by their sequence similarity. In other words, we build a sequence similarity network, which is a graph where each node is a gene sequence, and each edge is the sequence similarity of the genes it connects. Clusters from these networks are typically a good estimate to get groups of genes we can analyze with other methods. With sufficient data, the true signal becomes distinguishable from background noise.

The problem we encountered is that we didn’t have enough resources to actually find clusters in these networks. We get better results with more data, but the size of sequence similarity networks scales quickly as we add more data. The average E. coli genome has around 4,200 genes. If we sequence 1,000 of these genomes, that’s 4,200,000 genes. We typically use reciprocal best-BLAST hits, so each gene will only have a similarity to one gene per other genome, but even with that, we’re looking at around 2.1 billion edges.

Let’s think about that in terms of computational requirements. Each edge is undirected, so it needs at least two IDs corresponding to the nodes it connects. They’re also weighted, so they need a representation of the weight of the edge. 4.2M is just barely small enough to fit into an unsigned 32-bit integer, but if we grew at all it would be insufficient. That means we’ll need two 64-bit integers (16 bytes) and one float (4 bytes) per edge. 20B per edge with 2.1 billion edges is 40GB of space. Now note here that this is just to store the network, and doesn’t include any additional processing overhead (e.g., clustering, or even how to get node labels into nicely indexed 64-bit integers).

A thousand genomes isn’t even that large – our current analysis is looking 4,422 complete genomes from RefSeq, which comprises around 12 million nodes and 20 billion edges. Storing that in the aforementioned format would take 400GB of RAM just for the network itself. Maybe we leverage some sparse encoding techniques to shave off one of the integers from the edge representation; even with that, we’re still looking at 12 bytes per edge, and 240GB to hold the network.

This isn’t our end goal. We’re looking to scale way past 4,422 genomes, but the scaling of these networks is not sustainable with current hardware. Sure, there are systems that have terabytes of RAM, but note the scaling of memory requirements with input size. When we moved from 4M genes to 12M (roughly 3x more), the RAM requirement increased by 10x. By that logic, going to 36M genomes would take at least 4TB of RAM, and 108M genes would take at least 40TB. The actual scaling is nonlinear, so we’d probably require a lot more than 40TB of RAM.

This is where ExoLabel comes in. We can’t simply keep buying bigger hardware to process networks of this size, at least in our current compute environment. Maybe Big Tech has the resources to keep pace with this, but few academic labs have access to machines with multiple terabytes of RAM. Could we cluster networks in a way that somehow uses less RAM?

The Solution

There’s a solution to this issue that’s very simple in theory: why not just offload the data from RAM to other storage? Much like a SQL database, we could store all the graph information somewhere on disk and just query for what we need, when we need it. If the clustering algorithm we use only needs data on a single node and its neighbors, we could reduce our memory complexity from scaling with the number of edges to scaling with the maximum node degree (asymptotically equivalent to scaling with the number of nodes, but much better for sparse networks). The critical issue is that read/writes to disk are extremely slow compared to RAM, even with SSDs. Solving memory complexity at the cost of infinite runtime is by no means a solution, so I had to spend a lot of time optimizing our implementation to work nicely with disk drives.

I’ll start with the core clustering algorithm. I expected this to be the hardest part of the project, but it ended up being much easier than the database construction portion. I chose Fast Label Propagation for a couple reasons. First, it’s a recently published algorithm, so I have relatively high confidence that it’s competitive with prior approaches. Second, the core algorithm only needs information on a single node and its neighbors to cluster that node, which meets my algorithmic needs to leverage a database structure. Third, it’s fast (it says so in the name!). Lastly, label propagation is a relatively well-studied and commonly used approach for clustering sequence similarity networks.

Label propagation is a pretty simple algorithm at its core. We start by setting each node to be in its own cluster. Then, for each node, we consider all the incoming edges to that node. Each incoming edge starts at a different node in some cluster. We add up the incoming weights for each of these clusters, and then assign the node to the highest weighted cluster. For instance, suppose we have a node A with three neighbors, B,C,D. Nodes B,C are in cluster 1 and node D is in cluster 2, and all the edges have weight 1.0. Then cluster 1 has a total incoming weight of 2, and cluster 2 has a total incoming weight of 1. We then assign A to cluster 1. In fast label propagation, we keep a queue of nodes we’re going to process (initially containing all nodes). Whenever a node changes its cluster, we add all neighbors in different clusters to the queue (if they’re not already in it). There’s a few more optimizations I added to this algorithm, but I’ll come back to those in the deep dive section.

Next, let’s talk about the database construction. Since I’m using label propagation, I needed a way to quickly look up the incoming edges for any particular node. It’s also important to be aware of the problem setting: most networks I’m going to process are going to be relatively sparse in general, so something like an adjacency matrix would be way overkill. I settled on using an adaptation of a compressed-sparse row (CSR) format for the database. A CSR-encoding stores the end vertices for each edge back to back, and then stores an index somewhere that determines where the edges for each node live (note that this can be swapped to store the start vertices for each edge, I’m just using this representation because it’s most efficient for label propagation). It’s more easily described with an example.

Suppose we have a network with four nodes, A,B,C,D, and the following connections: A->B, B->C, C->D, D->A, A->C, B->D. We start by counting the number of incoming connections for each node:

A: 1 (D->A)
B: 1 (A->B)
C: 2 (A->C, B->C)
D: 2 (B->D, C->D)

We then form an index using the cumulative counts of these node degrees, and then store the start nodes inline afterward:

1 1 2 2 -> 0 1 2 4 6 (add a 0 at the beginning)

CSR:
0 1 2 4 6
D A A B B C

Why do this? This actually gives us a fast way to look up incoming connections if we know how what order the vertices come in. Here we ordered our representation as A,B,C,D. Suppose we wanted to get the incoming edges for node C. We know that C is the 2nd node (if we’re using 0-indexing), so we look at the 2nd and 3rd values of the index, which corresponds to [2,4]. This tells us that the edges at positions [2,4) (not including the end position) belong to node C. This is also the reason we had to add a 0 to the beginning of the index – we need n+1 indices to store n nodes, since each node i is defined by a range [index[i], index[i+1]).

0 1 [2 4] 6
D A [A B] B C

Node C has two connections (4-2=2)
They are from nodes B and A

This is a nice representation for a couple key reasons. First, it stores all the edges for a particular node in a contiguous block. Disk drives are most efficient at sequential reads, so this allows ExoLabel to read all the edges for a particular node sequentially rather than jumping around in the database. Second, it stores the minimum amount of data necessary for each edge – since we know the destination node implicitly using the index, we only have to store the source node (for directed graphs – for undirected graphs, we have to store each edge as two directed edges). For weighted graphs, we can either store the weights inline with the edges or in a second table with matched format.

Performance

Before digging into the details, I’ll give a brief description of its performance. Note that this is a work in progress – I’ll update this section as I finish the rest of my benchmarks. Note that the RAM consumption doesn’t include the amount of RAM required for R and the SynExtend package, which is around 300MB on my machine. These tests were performed on an M1 MacBook Pro with 16GB RAM and graphs stored on an internal SSD. All these test cases are real sequence similarity networks. The final test read the input file from an external HDD connected via USB-C, with intermediate files stored on the internal SSD. Edges are directed, so the number reported is twice the number of undirected edges.

Vertices	Edges	Runtime (MM:SS)	RAM Consumption	Disk Consumption
56,266	686,286	00:02	113 MB	22.0 MB
128,008	1,503,044	00:02	132 MB	50.7 MB
1,375,735	156,434,932	01:43	271 MB	5.0 GB
3,500,903	937,020,456	15:17	380 MB	29.9 GB

Accuracy benchmarks are forthcoming. Anecdotally, it produces pretty good results. For reference, HipMCL required 240 cores and 15TB of unified RAM to process a similar sized network to ExoLabel’s final trial (with roughly 3.5M nodes, 700M directed edges) in 30 min. MCL scales quadratically so it’s not the most fair comparison, but it is the standard approach in the field.

That’s the high-level view of ExoLabel. We first read the input data into a CSR format on disk, and then we use fast label propagation, querying the CSR table for relevant data when we process each node. Doing that in an efficient way results in pretty good runtime – not as good as a completely in-memory algorithm with access to infinite RAM, but much better than a limited machine that has to rely on swap. The next section will detail all the nitty-gritty, so if you’re not interested in that, feel free to stop reading here.

Deep Dive: How does it really work?

Let’s now go through how ExoLabel actually works in detail. There are 5 key steps:

Reindex the nodes
Record the edges (happens in parallel with (1))
Sort the edgelist file
Do the clustering
Write out the results

Step 1: Reindexing

ExoLabel uses integer-indexed nodes, but the input data won’t be formatted in that nice format. The output of BLAST searches is usually in plain text and stored like the following:

VERTEX1 VERTEX2 SIMILARITY
VERTEX1 VERTEX2 SIMILARITY
VERTEX1 VERTEX2 SIMILARITY

For example:

abc def 0.0451
abc ghi 0.8713
def ghi 0.2301
def xyz 0.5678

I don’t want to use string-based indexing. Strings are messy – they’re slow to compare (relative to integers) and have highly variable space requirements. I’m working in C for this, so I don’t have a simple string class. Each string could take any number of bytes, potentially even more than the 8-bytes per node required of integer indexing. Variable width fields also make it hard to read in edges from the CSR compression. With integer indexes, if I know that there are 10 edges starting from index 20, I can just move the file pointer to position 20 and read in 10*8 bytes. With strings, I’d have to also store the number of bytes to read and the lengths of each string in the field.

In order to transform the string input to integers, I’m using a trie. Tries are not the most efficient way to map strings to integers; we could theoretically just hash the string. However, we have to be able to write out the clusters at the end of the function. Users aren’t going to want random indexes, they’re going to want the labels they provided. This means I have to store all the vertex names somewhere on the computer. It’s technically possible to store them on disk, but this ends up getting extremely complicated (mainly because of variable length fields, again). I settled on an in-memory trie because it has fast access and the space complexity is very good for solutions that store the entire string.

The trie structure has two types of components: internal nodes and leaf nodes.

First, the leaf nodes:

typedef struct leaf {
  uint64_t count; // also tracks the cluster number
  uint64_t index;
  uint64_t edge_start; // start position of edges in the disk file
  uint32_t dist; // distance to original label, used for attentuation
} leaf;

The leaf nodes have a number of attributes. index is the most important one here; it stores the index of a given string in a 64-bit unsigned integer. As I read in each node, I try to insert it into the tree. If it doesn’t exist, we insert it and assign it to the next available index.

The other attributes are for later clustering steps. count stores the in-degree of each node, which we need for the CSR compression later. During the clustering step, it stores the cluster the node is currently assigned to. This makes some of the variable names a little confusing, but is worth it because it saves a lot of memory. edge_start stores the offsets for the CSR compression. In a typicaly CSR format, this is stored in the file itself, but moving it into memory saves a lot of runtime by reducing how much we have to jump around in the file. The cost is 8 bytes per node, which isn’t a ton (100M nodes would only be 800MB). dist is for attenuation, which I’ll talk about in Step 3.

I’m planning to eventually combine the index and edge_start variables, since they’re never used at the same time…I just haven’t gotten to it yet.

Next, the internal node:

typedef struct prefix {
  uint64_t bmap1 : 56; // 0, 32-86
  uint8_t count1 : 8;  // counts in this bitmap
  uint64_t bmap2 : 42; // 87-127
  uint8_t count2 : 8;   // counts in this bitmap
  void **child_nodes;  // 0 will be leaf, else will be prefix
} prefix;

This structure is designed to be as light on memory as possible. There are 128 ASCII codes, of which only the values 32-126 are printable (I also included 127 by accident…it’s not needed though, and it doesn’t hurt). Internal nodes have a total of 3 elements: a 98-bit bitmap, a count of how many values are in the tree, and a pointer to an array of pointers. Let’s suppose I only supported the numbers 0-7, and wanted to insert one of them into a leaf:

leaf structure:
  bitmap: 0000 0000
  count: 0
  children: []

>> insert 6 <<
bitmap = bitmap OR 6
count++
children.append(child6)

leaf structure:
  bitmap: 0000 0100
  count: 1
  children: [child6]

To find children, we shift through the valid bits of the bitmap to figure out which character the next child in children corresponds to. In this case, children[0] is a child node corresponding to the current prefix plus the number 6. This allows each prefix to store up to 98 children, but without requiring that we allocate 98 pointers at each node on initialization. It’s basically a sparse format. The reason there are two bitfields is because there are 98 characters, so a single 64-bit integer wasn’t large enough (and 128-bit integers aren’t portable).

This takes care of prefixes, but what if the current node is the end of a string? If we knew that every child was another internal node, we could make children of type struct prefix**. However, sometimes we have a child that is of type struct leaf, so children has to be void**. I didn’t just make a single struct for both because the leaf structure has to hold a lot more data. If internal nodes also had the same fields, I’d be wasting tons of RAM.

The leaves are always stored at the first bit of the bitmap, so if prefix.bmap1 & 1 == 1, then the first entry in children is a pointer to a struct leaf object. The first bit is used because it corresponds to an ASCII code of 0, which is the null-terminator for strings. All other entries in children are pointers to struct prefix elements. The count variables allow for a little bit of optimization so I don’t have to exhaustively check every bit every time.

The first step passes through the input edgelist files. The separator between entries is provided as a parameter and typically set to \t (as in a .tsv). The algorithm reads characters into a buffer and looks for the separator. When the separator is encountered, it tries (lol) to insert the prefix into the trie. If it exists already, we increment the count value of the leaf. If it doesn’t, we make a new leaf and set its count value to 1. If we’re reading in undirected edges, we only increment count if the node is the destination node for the edge.

Step 2: Recording edges

In an earlier implementation of ExoLabel, this step happened after step 1. However, due to some other optimizations, it now happens at the same time as step 1.

In step 1, ExoLabel indexes all the nodes and records the in-degree of each node. At the same time, we write all the edges that will eventually become the CSR-format to a file. This step won’t make any sense without a brief description of what’s coming, so let’s briefly take a detour to talk about step 3.

Recall that we’re trying to build a CSR-representation of the network. In order to do that, we have to have all the source nodes for each edge ending at each node in contiguous blocks in the file. At first, I did this by recording the in-degree of each node in the first pass through the file, then recording the values at the correct position during a second pass. This makes a lot of sense if you’re operating in-memory, but it is a terrible decision when working with disk drives. Because of how spinning-disk drives operate, moving to a random position on a file that lives on a drive is closer to a linear worst-case time complexity, rather than the constant time complexity you’d expect in RAM. SSDs are a lot better at this, but even they struggle with random read/writes due to things like caching/prefetching and write amplification.

The right approach is to play to the strengths of physical disk drives: sequential read/writes. Pretty much everything comes back to minimizing the total number of reads/writes, and making the remaining necessary read/writes sequential.

Think back to the CSR compression. We have to have each node’s edges be contiguous, and every node is indexed by an integer. The key idea here is that if we record each edge as [end, start] and then sort them by their first entry, the resulting edges will be grouped in CSR format. For example, with the case from earlier:

Input network:
A->B, B->C, C->D, D->A, A->C, B->D

Sort edges by destination node:
D->A, A->B, A->C, B->C, B->D, C->D

Discard destination node:
D A A B B C

This gets us a CSR format graph, assuming we have the index stored somewhere else. Since the in-degree for each node is stored in the trie as they’re read, it’s easy to construct an index after all edges are recorded.

Sorting the list of edges is a good idea because we can do it entirely with sequential read/writes using merge sort. While this has n*log n complexity (n the number of edges), it ends up being significantly faster than the naive approach because sequential read/write is constant time complexity, whereas random read/write is effectively linear (making the naive approach closer to n^2 scaling).

As we traverse the file in step 1, we also record the edges. Since step 3 involves merge sort, I frontload part of the operation by sorting fixed size buffers prior to writing. Practically, this means that ExoLabel reads in around 40,000 edges at a time (converting strings to indices as they’re read in), sorts the list of ~40k edges, then writes those to the file and clears the buffer. These writes are all sequential and at the end of the file, so they’re extremely fast. This pre-sort step saves a lot of time later – merge sort is most time-consuming at the early stages when it’s merging small blocks (especially when those blocks are on disk and not in RAM), and it technically only adds linear time complexity since each sort is on a constant-size array.

It’s important to note that the buffer used to hold edges has to be global; when reading in multiple input files, the ends of files may not match up perfectly with buffer sizes. In tihs case, the next file should continue writing edges to the buffer prior to sorting and flushing the buffer so that all blocks in the resulting file are the same size (except potentially the very last block).

The catch is that this approach requires that both vertices be recorded. One of the big advantages of CSR compression is only one of the nodes has to be saved. We also need to record the weight (4 bytes if using float), for a total of 12 bytes. Recording both vertices theoretically causes the overall disk space requirements to increase to 20 bytes per edge. Optimal merge sort requires a second copy of the file as well, so we’re up to 40 bytes per edge. Not great.

I solved this by compressing each edge into a smaller format. Rather than recording each edge as end, start, weight, I’m using two 64-bit integers end, comp. Here, comp is a compressed combination of the start node and the weight.

This compression happens as the nodes are read in. For each index, the first 44 bits are reserved for the index of the source node. This reduces the total number of nodes we can process, but 2^44 is over 17 trillion, which should be more than enough nodes. When compressing the weight, I left shift it until the topmost bit is 1 or I’ve made 15 shifts (the max amount that fits into 4 bits). The number of shifts is stored in the next 4 bits. Finally, the transformed weight is truncated to the topmost 16 bits, which are stored at the final 16 bits. It’s essentially a modified 16-bit floating point number that doesn’t allow negative values or exponents.

Using this compression, each edge occupies 16 bytes. Factoring in the merge sort, the maximal bytes per edge is 32 bytes. This is an extra 20 bytes per edge over the original implementation that didn’t use sorting, but it takes one fewer pass through the edgelist files and writes to disk an order of magnitude faster. Although I’d love to have less disk consumption, the practical consumption is around the same size as the input edgefiles in most tests, so it’s not a huge deal. I would be more concerned if there were orders of magnitude more disk consumption than the input file size. Worst case, I can add a flag to delete input files as they’re read in (and potentially rewrite them at the end), which would drastically reduce overhead at the cost of modifying input data.

There is also slight loss of precision, but it’s on the order of 0.01% or less for nearly all input values. The highest loss of precision by percentage is at extremely small weights, where the loss in precision isn’t super meaningful. The absolute error scales with the magnitude of the weights, but again this isn’t a huge cause for concern. For weights of around 60k, the error is around 10. If clustering is dependent on extremely small variations in weights then this may not be a good approach, but I imagine these scenarios to be very limited. The number of bits allocated for weights can also be adjusted to get more precision, though each additional bit for weights or exponents halves the maximum number of nodes supported.

Step 3: Sorting

I already mentioned that the next step is sorting the edges in the file. I’m using an external merge sort for this operation. I’ve actually already written a very in-depth explanation of what’s going on here, so I’ll just link to my previous blog post on loser trees. In short, I use a tournament tree (also known as a loser tree) to perform a multi-way merge sort on the file. Classical merge sort is a 2-way merge because it merges two blocks at a time. This implementation uses up to a 64-way merge depending on how many blocks are present in the file. Merging more blocks at a time reduces the number of iterations required at the cost of making the merge step take longer. While this doesn’t change the asymptotic runtime, it’s important for files because the slowest operation is disk I/O (even if it’s sequential). Each iteration requires reading and writing the file once, whereas each merge step happens in RAM. Thus, reducing the number of iterations decreases the practical runtime by a lot, since disk I/O dominates the function runtime.

At the end of the sorting step, I have a sorted file containing compressed edges. I then iterate through this file, overwriting the file from the front with just the second entry of each edge (i.e., the compressed source/weight value). I truncate the file, then iterate over it a second time to split each compressed edge into a decompressed source node index and weight. The index overwrites the current file, and the weight is written to a second file. The file of indexes is called the neighbors table, and the file of weights is called the weights table.

I do this in two passes to reduce the total disk consumption – by first discarding the end node index, I reduce the size of the file by half. The next step of decompressing the edges increases the size of the file by 50%, which makes the overall maximal disk consumption less than that of the merge sort. We’d technically have less disk consumption than the merge sort step even if we decompressed first, but only if the merge sort isn’t in-place. I do have an in-place merge sort implemented, so doing it this way is consistent across both methods and ensures the same maximal consumption.

Step 4: Clustering

I’ve already somewhat described the clustering step, but there are a few more aspects to it that I skimmed over.

First, let’s review the core algorithm. I initialize a queue of nodes to process. For each node, we get the start and end index for its edges in the CSR database. Those edges are read in (from both the neighbors table and the weights table), and then the cluster with the highest weight is assigned to the current node. Each neighbor in a different cluster to the one I just assigned is added to the queue (if it wasn’t in the queue already). The clusters are stored in the count attribute of each leaf nodes.

The start indexes and clusters are stored in the leaf nodes of the trie, so how do we get to them quickly? Prior to clustering, I traverse the trie to build an array of pointers to each leaf node. This array is constructed such that array[i] is the leaf node corresponding to node i. Thus, array[i+1]->edge_start - array[i]->edge_start is the number of edges for node i. This means I can look up node data for any random node in constant time.

Label propagation has pretty good practical runtime, but can theoretically run forever. We stop once there are no more nodes in the queue, but cycles can appear that never terminate. To solve this, ExoLabel keeps count of how many times it’s seen each node. Once it’s seen a given node more than a predetermined amount (by default, the square root of the maximum node degree), it will no longer add the node to the queue. This prevents the algorithm from running forever.

I also mentioned that there’s a distance attribute in the leaf nodes. This is to solve the monster group problem that plagues label propagation algorithms. Label propagation is susceptible to grouping all nodes into a single giant cluster, which isn’t super informative. I use dynamically-scaling label hop attenuation (as introduced by Leung et al., 2009), which reduces the contribution of a cluster the farther it’s traveled from its original point. The amount that the weights are attenuated scales based on the proportion of nodes that changed label in the previous iteration. The distance attribute in the leaf nodes stores the minimum distance to the origin of the current cluster, so it can be calculated in constant time.

Step 5: Output

At this stage, each node’s final cluster is stored in the count attribute of the corresponding leaf node in the trie. Additionally, each label is stored along the paths of the trie. This means that the labels and their corresponding clusters can be recovered with a simple depth-first traversal of the trie structure. The labels are cached along each node as the trie is traversed with a standard backtracking algorithm. When a leaf node is encountered, the current label and the cluster are written to the outfile.

Conclusion

I think this is one of my longest blog posts, ever. If you’ve made it this far, thanks for reading. Check out the code for ExoLabel in the SynExtend package on GitHub, and stay tuned for a paper on it in the near future!

Converting vectors to dendrograms in R

2024-08-18T00:00:00-04:00

I do really like R’s dendrogram object, but it can be really clunky to work with them. I recently implemented random forests from scratch, and the decision trees within were stored as two vectors. However, it would be really nice to be able to plot these decision trees to visualize their contents. This got me thinking–is it possible to convert vectors of values into dendrogram objects in R if we know the vectors are ordered in a known tree traversal? In other languages this would be fairly simple, but the nested list structure of dendrogram objects (and their other attributes) makes it a little trickier in R.

Setup

Let me explain the problem a little more clearly. Our input is minimally an integer vector, with an optional second vector. The integer vector encodes nodes–positive values indicate internal nodes, whereas negative values indicate leaves. The second vector is paired with data we want to include at each node; this could be thresholds for a decision tree node, labels to print, or whatever. I’m assuming the input is ordered along a breadth-first traversal. Let’s see what that would look like for a small tree:

       a
     /   \
    b     c
   / \
  d   e

 labels: a  b  c  d  e
indices: 1  1 -1 -1 -1

I’m also assuming that this tree is fully bifurcating, with no interior nodes having outdegree 1. In other words, all interior nodes have exactly two children. The output we’re expecting is a dendrogram object with the same structure as the tree implied by the labels/indices vectors.

What makes a dendrogram?

dendrogram objects are nested lists with a set of attributes. Each internal node of the dendrogram has the following attributes:

members: number of leaves below this node (1 for leaves)
height: height of the node
midpoint: (optional) x offset relative to the leftmost child for plotting

Leaf nodes have a members attribute of 1, usually a height attribute of 0, and no midpoint attribute. They also have the following extra attributes:

label: label of the leaf
leaf: logical always set to TRUE

One important note is that these are largely nested list objects with a bunch of attributes. What happens at the leaves? Are they just empty lists?

The answer is no. In fact, if you call unlist on a dendrogram, you’ll get back a vector of integers. The leaf nodes are single integer values with additional attributes. In the previous example, the dendrogram object internally (without all its attributes) would be equivalent to:

list(list(1L, 2L), 3L)

This is important. Lots of stuff breaks if you build a dendrogram object by hand that doesn’t have integers in the leaves.

dendrogram objects have another nice property, although it isn’t specific to the dendrogram class. Sublists in any nested list structure can be accessed using either multiple [[ calls, or vectors of indices. For example:

x <- list(list(list(1,2), list(3,4)), list(list(5,6), list(7,8)))

x[[1]][[2]][[1]]
# 3

x[[c(1,2,1)]]
# 3

This latter accession mode is going to be extremely useful.

Building the nested list structure

Breadth-first searches are typically done using queues–for each node, we process it, then add its children to the end of the queue. This is what makes this operation difficult in R…we can’t store pointers to nodes like we could do in (for example) C. However, we can actually build a queue accessing the nodes of the tree by using vectors of accessors. We can start with the root and a vector of accessors list(1,2). At any particular node x, its children are x[[1]] and x[[2]]. That means that, given an accessor i, if we append list(c(i,1) and list(c(i,2)) to our vector of accessors, we now have “pointers” to the children of the node accessed at root[[i]].

f <- function(node_indices, node_data){
  ## initialize the root node
  root <- vector('list', length=2L)
  attr(root, "members") <- 0L
  attr(root, "height") <- 0
  attr(root, "midpoint") <- 0
  attr(root, "otherdata") <- node_data[[1]]
  class(root) <- "dendrogram"

  ## set up a queue
  cur_q <- list(1,2)
  ctr <- 2L
  leafctr <- 1L
  while(ctr <= length(node_indices)){
    accessor <- cur_q[[ctr]]
    is_leaf <- node_indices[ctr] > 0
    otherdata <- node_data[[ctr]]
    if(!is_leaf){
      ## interior nodes are lists
      cur_node <- vector('list', length=2L)
      attr(cur_node, 'midpoint') <- 0

      ## add children to the queue
      cur_q <- c(cur_q, list(c(accessor, 1L), c(accessor, 2L)))
    } else {
      ## leaves are integers
      cur_node <- leafctr

      ## extra leaf attributes
      attr(cur_node, 'leaf') <- TRUE
      attr(cur_node, 'label') <- as.character(leafctr)

      leafctr <- leafctr + 1L
    }

    ## add attributes for all nodes
    attr(cur_node, 'height') <- 0
    attr(cur_node, 'members') <- 0L
    attr(cur_node, 'otherdata') <- otherdata
    class(cur_node) <- 'dendrogram'

    ## assign as a child of the current node
    root[[accessor]] <- cur_node
    ctr <- ctr + 1L
  }

  ## What are we missing here?

  root
}

Fixing the nodes

This is pretty close! There’s one small issue that you may have noticed in the prior function–all the attributes are wrong! We set members and height (and midpoint) to zero for every node, which isn’t really correct. If we try to plot the resulting object, it’ll be garbage.

The reason these are set to zero is because there isn’t a great way to determine what the correct values of these should be during the initial processing. It’s much easier to build the dendrogram object and then correct the values later. For this, I’m going to use my version of dendrapply (available in SynExtend) because it supports post-order traversals, which are important for this.

For each node x, we have to correct members, height, and midpoint. The members attribute is the number of leaves, which we can get with length(unlist(x)). The height attribute is relatively arbitrary, but each node has to be higher than its children for plotting. We’ll just set leaves to zero, and then interior nodes to max(height(x[[1]]), height(x[[2]])) + 1L.

The last attribute is midpoint, which can be relatively complicated. This attribute determines where the node is placed on the x-axis relative to its leftmost child. I’m not entirely sure why dendrogram objects plot using this parameter, but the relative referencing makes things complex. Each leaf is plotted with distance 1.0 from subsequent nodes. Thus, if the children of x are both leaves, the midpoint is 0.5–halfway between the leaves, since the leaves are distance 1.0 apart. The other cases are more complicated, but I’ll include the code below and leave the reasoning as an exercise for the reader.

f <- function(node_indices, node_data){
  ## ... everything from before

  ## here's what we were missing:
  midpoint <- \(x) attr(x, 'midpoint')
  height <- \(x) attr(x, 'height')
  root <- dendrapply(root, \(x){
    if(!is.leaf(x)){
      ## internal nodes
      attr(x, 'members') <- length(unlist(x))
      attr(x, 'height') <- max(height(x[[1]]), height(x[[2]])) + 1L

      ## midpoint calculation
      mp <- 0
      child_is_leaf <- c(is.leaf(x[[1]]), is.leaf(x[[2]]))
      if(child_is_leaf[1] && child_is_leaf[2]){
        ## both children leaves
        mp <- 0.5
      } else if(child_is_leaf[1]){
        ## only left child a leaf
        mp <- ((midpoint(x[[2]]) + 1L) / 2)
      } else if(child_is_leaf[2]){
        ## only right child is a leaf
        mp <- ((midpoint(x[[1]]) + 1L) / 2) + midpoint(x[[1]])
      } else {
        ## both children non-leaves
        mp <- (attr(x[[1]], 'members') + midpoint(x[[1]]) + midpoint(x[[2]])) / 2
      }
      attr(x, 'midpoint') <- mp
    } else {
      ## leaves
      attr(x, 'members') <- 1L
    }

    x
  }, how='post.order')

  root
}

Conclusion

This doesn’t put together the entire function–if you’re interested in the complete thing, you can check out the source code on GitHub. Thanks for reading!

Automated R Testing and Coverage on GitHub (without Codecov!)

2024-08-15T00:00:00-04:00

I’ve recently been working on adding some unit testing to Biostrings as part of working I’m doing for a grant awarded by R’s Infrastructure Steering Committee. As part of implementing unit tests, I wanted to add an automatic workflow that would evaluate the current tests on any future pull requests, so that (1) we could be sure contributed code isn’t breaking any additional functionality (2) we can be sure that contributed code is adequately tested.

The easiest way to do this is to set up testing with testthat and covr, and then use Codecov.io to store coverage reports. There’s even a GitHub action already set up to do this! My first attempt was to do exactly that–testing and code coverage is calculated with this GitHub action, results are uploaded to Codecov, and Codecov automatically adds a comment to the PR with the status.

Unfortunately, it turns out that this isn’t super feasible for Biostrings. Codecov is free for single users, but begins to get much more expensive as you scale up to more and more users. Additionally, Codecov needs access to at least one user’s OAuth token, and they have to be an admin of the repository in question to be able to add comments to PRs. As I am both broke and not the owner of the Biostrings repository, this unfortunately isn’t a feasible solution.

My solution: a custom workflow

There are three things I wanted to accomplish with my workflow:

Run all unit tests in the package, and report any that had unexpected behavior
Calculate the code coverage of tests, and how its changed relative to the base repository
Report results to users in a way that doesn’t require elevated permissions

I ended up writing my own workflow. It works for R packages using testthat as a testing environment, but could easily be adapted to any other testing setup. The result is printed on the Job Summary page, and renders into something like this:

Main output

Expanded table

Some failing tests

Failing test detail

How does it work?

The process essentially looks like this:

Pull the code in the PR
Pull the base repository code (the current version)
Install R and set up dependencies for both packages
Check unit tests on the new code
Calculate code coverage on new code and the base repository, and report changes
Display all results to users

Steps 1-3 are fairly easy using prebuilt GitHub Actions. We can do all of them with a few lines:

steps:
  - name: Checkout current ref
    uses: actions/checkout@v4
    with:
      path: ./new-state

  - name: Checkout Biostrings devel ref
    id: devel-checkout
    uses: actions/checkout@v4
    with:
      repository: Bioconductor/Biostrings
      path: ./original-state

  - uses: r-lib/actions/setup-r@v2
    with:
      use-public-rspm: true

  - name: setup dependencies for old state
    uses: r-lib/actions/setup-r-dependencies@v2
    with:
      working-directory: ./original-state
      extra-packages: any::covr
      needs: coverage

  - name: setup dependencies for new state
    uses: r-lib/actions/setup-r-dependencies@v2
    with:
      working-directory: ./new-state
      extra-packages: any::covr
      needs: coverage

This loads the contributed code into ./new-state and the original repo’s base branch code into ./old-state.

After this, I call a long R script that accomplishes (4-5). The script does the following:

First, we run the unit tests on the new version of the package:

## first check unit tests
cat("Checking test results...\n")
res <- testthat::test_local("./new-state", stop_on_failure=FALSE, reporter="check")
res <- as.data.frame(res)
test_report <- c(sum(res$failed), sum(res$warning), sum(res$skipped), sum(res$passed))

Throughout this process, I’m going to build an object called out_msg. This variable holds a Markdown-formatted string that we’ll eventually print as output to users. At this point, I’m going to initialize out_msg, and then add in some diagnostic information on tests that failed or threw warnings (if any):

## build the output message
out_msg <- '# Testing Report\n\n'
out_msg <- paste0(out_msg, "## Test Results:\n\n")
out_msg <- paste0(out_msg, "Please note that test coverage is **not** an ",
                  "end-all-be-all measure of robustness. Having tests that ",
                  "correctly cover intended use cases and potential errors ",
                  "is significantly more important than maximizing coverage.\n\n")
out_msg <- paste0(out_msg, "```\n", test_report, '\n```\n\n')

## if any tests failed or threw warnings, report them
shouldStop <- test_report[1] > 0
shouldPrint <- sum(test_report[1:2]) > 0
test_report <- paste(c("FAIL", "WARN", "SKIP", "PASS"), test_report, collapse=' | ')
test_report <- paste('Unit Tests: [', test_report, ']')
if(shouldPrint){
  ## put failing/warning tests into a markdown table
  p_toprint <- which(res$failed + res$warning > 0)
  ptp <- res[p_toprint,]
  failed_tests <- ptp[,c("file", "test", "warning", "failed")]
  failed_tests <- apply(failed_tests, 1L, paste, collapse=" | ")
  failed_tests <- paste("|", failed_tests, "| ")
  failed_tests <- paste(failed_tests, collapse='\n')
  md_tab <- paste0("| Test File :page_facing_up: | Test Name :id: | Warnings :warning: | Failures :x: | \n",
                  "| :-----: | :-----: | :-----: | :-----: | \n",
                  failed_tests, "\n\n")
  out_msg <- paste0(out_msg, "### Warning/Failing Tests:\n\n", md_tab)
}
if(shouldStop){
  ## if any errored, stop the workflow without continuing to test coverage
  cat(out_msg, file='./test_status.md')
  stop("Some tests failed! Skipping coverage report.")
}

Notice that if any tests failed, we stop early. This is because there isn’t a good way to run covr with tests that fail. testthat allows for test to continue running even if some fail, whereas covr doesn’t support that option. Additionally, if a test failed, fixing that is more important than calculating coverage anyway.

Next, we calculate the coverage on both the old and new code. This is done on every run–it’s probably possible to cache results on the base repository, but it adds some complexity and wasn’t a big enough improvement in performance for me to want to implement it.

## if no tests failed, check coverage of old vs. new
library(covr)

# exclude lines with no content
options(covr.exclude_pattern=c("^[ \t{}()]+$"))
# get results on old state
files_to_ignore <- list("R/AMINO_ACID_CODE.R", "R/GENETIC_CODE.R",
                        "R/zzz.R", "R/IUPAC_CODE_MAP.R",
                        "R/getSeq.R")
## old state coverage
cov <- covr::package_coverage(
  path = "./original-state",
  quiet = FALSE,
  clean = FALSE,
  install_path = file.path(dirpath, "old-state"),
  function_exclusions = "^\\.",
  line_exclusions=files_to_ignore
)
head_res <- covr::coverage_to_list(cov)

## new state coverage
cov <- covr::package_coverage(
  path = "./new-state",
  quiet = FALSE,
  clean = FALSE,
  install_path = file.path(dirpath, "new-state"),
  function_exclusions = "^\\.", # excludes functions starting with .
  line_exclusions=files_to_ignore
)
new_res <- covr::coverage_to_list(cov)

## compare difference in coverage
f_old <- head_res$filecoverage
f_new <- new_res$filecoverage

Now that we have coverage on both the old and new code versions, a lot of code goes into transforming raw values into pretty printing for the eventual Markdown file.

## get changes in coverage for each file
all_files <- union(names(f_old), names(f_new))
file_changes <- rep(0, length(all_files))
names(file_changes) <- all_files
file_changes[names(f_new)] <- file_changes[names(f_new)] + f_new
final_cov <- file_changes ## this is the new coverage of all files
file_changes[names(f_old)] <- file_changes[names(f_old)] - f_old

## get the change in overall coverage
total_change <- new_res$totalcoverage - head_res$totalcoverage

## start appending output information
out_msg <- paste0(out_msg, "## Negatively Impacted Files\n\n")

## If any files lost coverage, add them here
n <- names(file_changes)
pos_neg <- which(file_changes < 0)
if(length(pos_neg) > 0){
  pos_neg <- pos_neg[order(file_changes[pos_neg], decreasing=FALSE)]
  warn_changes <- sprintf("%+.01f%%", file_changes)
  header <- "| File name | Coverage | Change |\n | :----- | :-----: | :-----: |\n"
  warn_tab <- paste0('| ', n[pos_neg], ' | ', sprintf("%0.02f%%", final_cov[pos_neg]), ' | ',
                      unname(warn_changes[pos_neg]), ' |', collapse='\n')
  warn_tab <- paste0(header, warn_tab)
  out_msg <- paste0(out_msg, "The following files have lost coverage:\n", warn_tab, '\n')
} else {
  out_msg <- paste0(out_msg, "No negatively impacted files. Nice job!\n\n")
}

I’ll note for this next part that using diff-formatted Markdown is very nice for displaying file changes. You can tag lines as + to highlight them in green, and tag them as - to highlight them in red. All these lines put the file-specific coverage and changes in coverage into a diff-formatted table for future printing. We also enclose it in a <details> block so that it can be hidden, since this is a lot of extra content.

## build extended diff table

## going to split the files by whether or not they're R files or src files
p_Rfiles <- grepl("^R/", n)

## lots of formatting to get consistent entry widths for the diff table
n <- vapply(strsplit(n, '/'), .subset, character(1L), 2L)
all_diffs <- data.frame(filename=n,
  coverage=sprintf("%.02f%%", final_cov),
  change=sprintf("%+.01f%%", file_changes))
max_nchar <- max(nchar(all_diffs$filename))
all_diffs$filename <- sprintf(paste0("%", max_nchar, "s"), all_diffs$filename)
all_diffs$coverage <- sprintf("%7s", all_diffs$coverage)
all_diffs$change <- sprintf("%7s", all_diffs$change)
all_diffs$mark_char <- 1L
all_diffs$mark_char[file_changes > 0] <- 2L
all_diffs$mark_char[file_changes < 0] <- 3L
all_diffs$mark_char <- c(" ", "+", "-")[all_diffs$mark_char]

all_rows <- apply(all_diffs[c(4,1:3)], 1L, paste, collapse=' ')
w <- nchar(all_rows[1L])

## multiple sections, each title has to be centered within its block

## Section 0: total coverage
title0 <- "Total Coverage"
n_padding <- (w - nchar(title0) - 4) / 2
title0 <- paste0("@@", paste(rep(' ', floor(n_padding)), collapse=''),
  title0, paste(rep(' ', ceiling(n_padding)), collapse=''), "@@")
row0 <- paste(ifelse(total_change < 0, "-", ifelse(total_change>0, "+", " ")),
                sprintf(paste0("%", max_nchar, "s"), "Total Coverage"),
                sprintf("%6.02f%%", new_res$totalcoverage),
                sprintf("%+6.01f%%", total_change), collapse=' ')

## Section 1: R file coverage
title1 <- "R/... Files"
n_padding <- (w - nchar(title1) - 4) / 2
title1 <- paste0("@@", paste(rep(' ', floor(n_padding)), collapse=''),
  title1, paste(rep(' ', ceiling(n_padding)), collapse=''), "@@")

## Section 2: src file coverage
title2 <- "src/... Files"
n_padding <- (w - nchar(title2) - 4) / 2
title2 <- paste0("@@", paste(rep(' ', floor(n_padding)), collapse=''),
  title2, paste(rep(' ', ceiling(n_padding)), collapse=''), "@@")

## section dividers
spacer <- paste(rep('=', w), collapse='')
entries1 <- paste(all_rows[p_Rfiles], collapse='\n')
entries2 <- paste(all_rows[!p_Rfiles], collapse='\n')

## final table
diff_table <- paste(title0, spacer, '\n', row0, '\n', spacer,
                    title1, spacer, entries1, spacer,
                    title2, spacer, entries2, spacer,
                    collapse='\n', sep='\n')

## enclose it in a <details> tag so it doesn't take up a ton of space
diff_table <- paste0("<details>\n<summary>Additional Details and Impacted Files:</summary>\n\n",
                      "```diff\n", diff_table, '\n\n```\n\n</details>')
out_msg <- paste0(out_msg, diff_table, '\n')
cat(out_msg, file='./test_status.md')

All of that content is put into a file called test_status.md. At first, I was using a GitHub Action to attach this file as a comment in the PR, but that unfortunately requires elevated permissions in the GitHub token used to run it. Even worse, it isn’t possible to auto-generate a token with the necessary permission pull-request: write on public repositories (for security concerns), so I’d have to ask Bioconductor to create me a token to use. Given that GitHub thinks this is a security risk, I decided I’d rather not risk it and go through the hassle.

It turns out that there’s another option. GitHub Actions have recently release Job Summaries, which allow you to print information about your workflow steps without requiring any additional steps. It unfortunately can’t print to PRs (yet), but it’s close enough and requires no elevated permissions. The remainder of my workflow file just needs to call the following steps:

      - name: Print results to summary
        if: always()
        run: cat ./test_status.md >> $GITHUB_STEP_SUMMARY

      - name: Upload status on success
        if: always()
        uses: actions/upload-artifact@v4
        with:
          name: coverage-test-results
          path: ./test_status.md

The first of these prints the contents of test_status.md to the Job Summary page, and the second uploads the raw markdown file. The if: always() tag ensures that this runs even if jobs fail, meaning that if we abort early (due to a failing test, for example) we still get output.

Conclusion

If you’re interested in the workflow, you can check it out on GitHub. Try it out for yourself if you’d like! In the future, I’m going to add more workflows to automatically run R CMD CHECK and BiocCheck::check() so that we can be sure the package is always ready to be pushed to Bioconductor. For other updates, follow the progress of my grant work here!

Writing a Random Forest from Scratch

2024-01-11T00:00:00-05:00

I’ve recently had to implement random forests from scratch in R. This is a much longer post than I normally make, since I’m going to go through all the details of actually implementing one of these models. By “from scratch”, I mean a complete Random Forest prediction model, written in R, with no packages aside from those provided in a base installation.

There are a bunch of steps involved, but before that, I’m going to address the most obvious question people will ask: why? There already exists the randomForest package for R that does a great job at implementing Random Forests, why reinvent the wheel? The answer is twofold.

First, my lab puts a high premium on software that doesn’t have external dependencies. My doctoral work partly depends on using random forest predictors, and we’d like to avoid having to rely on the randomForest package. Controlling all your dependencies means you know the codebase better, have full control on updating it, and you can ensure that it is fully interoperable with your own code. Obviously that isn’t always feasible, but in this case it is.

The second reason is a lot simpler: it’s a great learning experience, and a great excuse to finally use the Fortran skills I’ve been practicing over winter break.

Note to anyone planning to seriously follow this writeup: I use R, Fortran, and C together for my implementation. If you’re unfamiliar with R internals or the various ways to interface between R and Fortran/C, you may have trouble following some sections. I recommend looking at what is essentially the bible of R programming, Writing R Extensions, for a comprehensive description on things like .Call syntax and Fortran interfaces. If you’re interested in a more comprehensive description of Random Forests, check out the original publication by Leo Breiman.

This will be a work in progress until I finish my implementation

You can check out the current codebase at https://github.com/ahl27/machineRy. If you have suggestions for improvements, feel free to contact me or open an issue on GitHub.

Step 0: Planning

This is a big project, and I’m looking for a good, robust implementation. For things like this, the best first step is to plan out what you’re going to implement based on your priorities. I usually start by defining my priorities and the steps involved, and figure out which languages I’m going to use for what based on those two things together.

For myself in this project, the priorities were as follows:

It should work, at least for classification. No crashing R sessions.
Runtime and accuracy should be similar to randomForest. Lower runtime is acceptable if accuracy is higher.
User experience should be the same as other models in R (e.g., call with something like rf(response ~ ., data=data)
Models should be able to be saved/loaded in R.

Now, for the steps involved. Random Forests are a relatively simple algorithm that consist of a train and test phase. For a set of input data, we construct n decision trees. Each tree is constructed using bootstrapped sample of the data (sample some amount of rows with replacement). Thus, we need to be able to do the following things:

Correctly recognize what the user is asking for in R (parse formula objects)
Partition input data to improve prediction accuracy (i.e., a decision tree node)
Do (2) a bunch of times to make a decision tree
Do (3) a bunch of times to make a forest
Save (4) in such a way that it persists in R and can be saved without taking tons of memory
Make predictions using (5)

Under the constraints and priorities I have, the languages to use were pretty clear. First, the whole solution has to be R-compatible, so the only languages available to me are R, C, and Fortran. (1) will necessarily be in R, since the user interface will be R-exposed. (3-4) are major computational components and require tree structures, so C is a natural choice. (5) is likely going to be a combination of C and R, since R-Fortran interfaces are now generally discouraged. (6) is also going to be an R/C combo, since there needs to be an R interface but it still relies on tree structures (tree structures are fast and simple to implement in C but challenging in R). That just leaves (2), which is the most numerically intensive operation. For this, I’m going to rely on Fortran, since it does a good job with numerical calculations and is much easier for me to debug than C.

The last step is figuring out how to actually implement it. I’d like to test early and often, so ideally I develop in such a way that I start with self-contained components that can be tested in a vacuum. I also like to start with the toughest components to get them out of the way. I ended up on the following order of application:

Determine an R-compatible way to represent decision trees, and write code to read/write between R and C [C, some R]
Make decision tree nodes for classification [Fortran, some C]
Make a decision tree [C]
Make random forests [R, some C]
Figure out the formula syntax to train a decision tree [R]
Figure out the formula syntax to make predictions with a decision tree [R]
Extend to full random forests
Make decision tree nodes for regression [Fortran, some C]
Double check randomForest for features I may be missing
Optimize existing implementations

That being said, let’s jump into it!

Step 1: Internal Architecture

Determining how we’re going to represent decision trees is an important point, because everything else depends on it. If my structure is bad, then I’ll have to refactor significant amounts of code down the line. Looking at the priorities of the project, we want it to be a robust implementation with models that can be saved/loaded and good optimization in terms of memory usage and runtime.

Because of this, there are a few things we cannot do. The naive approach is just to build trees directly in R. However, memory allocation and garbage collection in R is slow, and R doesn’t have great support for tree structures. End users don’t really need direct access to each decision tree, so it’s okay if we obfuscate the internal model in something like C.

However, C presents its own challenges. While it is possible to save a pointer to a C object within R, these objects are super finicky. These “External Pointer” objects do not copy their values, and they cannot be saved across R sessions. That means that if your R session ever restarts (or if you try to save off the object), the external pointer will be garbage.

I settled on a mixed approach. We’ll have an R object that saves a compressed version of all the data required to reconstruct a decision tree, along with an external pointer object. Whenever we use this R object in C, we can check if the external pointer is a real object, or if its become garbage. If it is garbage, then we just reconstruct the object in C, point the external pointer at it and carry on.

We do still have to be careful here, since as mentioned previously, it isn’t super simple to store tree structures within R. I also want to make sure we’re not saving huge objects, since we’re going to have to make hundreds of these decision trees for each random forest. If a single decision tree takes 2MB to store, a 500-tree Random Forest will be 1GB!

I ended up with the following structure. First, we have this structure in C to define a decision tree node:

struct DTreeNode {
  struct DTreeNode *left;
  struct DTreeNode *right;
  double threshold;
  double gini_gain;
  int index;
};
typedef struct DTreeNode DTN;

Here DTN stands for Decision Tree Node. The basic structure is just a binary tree node, with pointers to the left and right nodes. I also have three additional variables: index, which defines which column of the data we split on, threshold, which determines the value of that column to split on, and gini_gain, which is the Gini gain of that split. When I eventually move on to regression, gini_gain can also hold the residual improvement.

This implementation actually allows for a very simple compressed storage in R. Internal nodes of the decision tree will always have a nonnegative value of index. We can then create leaf nodes by setting index to -1, and using threshold to store the prediction for that leaf node. For classification, we just cast the result to int, and for regression it’s already in the correct format. Then, we can read it out to R by traversing the tree in a breadth-first search. This allows us to store the entire tree as three vectors (one int, two double), which can be compressed in R using rle.

This means that, given these three vectors, we can reconstruct a decision tree by calling the following function:

// basic queue structure
struct DTNqueue{
  struct DTNqueue *next;
  DTN *ptr;
};
typedef struct DTNqueue queue;

DTN *bfs_q2tree(int *indices, double *thresholds, double *gini, int length){
  // set up a queue
  queue *q = malloc(sizeof(queue));
  queue *end = q;
  queue *tmp_q = q;
  DTN *tmp, *head;

  // initialize decision tree
  head = initNode();
  q->ptr = head;
  q->next = NULL;
  int i=0, cur_ind;

  while(q && i<length){
    // load value into queue
    cur_ind = indices[i];
    tmp = q->ptr;
    tmp->threshold = thresholds[i];
    tmp->gini_gain = gini[i];
    tmp->index = cur_ind;
    if(cur_ind > -1){
      // add both children of the node into the queue
      end->next = malloc(sizeof(queue));
      end = end->next;
      tmp->left = initNode();
      end->ptr = tmp->left;
      end->next = malloc(sizeof(queue));
      end=end->next;
      tmp->right = initNode();
      end->ptr = tmp->right;
      end->next = NULL;
    }

    i++;
    q = q->next;
  }

  // free the entire queue
  while(tmp_q){
    q = tmp_q;
    tmp_q = tmp_q->next;
    free(q);
  }

  // return the tree
  return head;
}

Then, we just need an R interface:

SEXP R_get_treeptr(SEXP VolatilePtr, SEXP INDICES, SEXP THRESHOLDS, SEXP GINIS){
  // if tree exists, just return the external pointer
  // note that it seems R_NilValue can be treated as an external pointer address for whatever reason
  if(VolatilePtr != R_NilValue && R_ExternalPtrAddr(VolatilePtr)) return(VolatilePtr);

  // otherwise, create the tree
  DTN *tree = bfs_q2tree(INTEGER(INDICES), REAL(THRESHOLDS), REAL(GINIS), LENGTH(INDICES));
  // using LENGTH because it makes calling the function a lot easier --
  // could be optimized slightly by calculating this on the R end

  int madePtr = 0;
  if(VolatilePtr == R_NilValue){
    // if the pointer is just NULL, we make a pointer for it
    VolatilePtr = PROTECT(R_MakeExternalPtr(tree, R_NilValue, R_NilValue));
    madePtr = 1;
  } else {
    // else just set the address of the pointer to the tree we just made
    R_SetExternalPtrAddr(VolatilePtr, tree);
  }
  R_RegisterCFinalizerEx(VolatilePtr, (R_CFinalizer_t) R_TreeFinalizer, TRUE);
  if(madePtr) UNPROTECT(1);
  return VolatilePtr;
}

It’s really important to test functions frequently! This is a set of functions that can be directly tested–even if we can’t “learn” decision trees, we can provide these functions with a set of dummy values to make sure it’s working properly. All we need are three vectors in R, and some way to print them. My logic for printing out a decision tree is…long, so I’m just going to say “trust me, it works”. If you’re interested in the full code, you can look at it on the project website. Just to give a sense of what this looks like, here’s one of my R functions for testing these functions:

test_balanced_tree <- function(tree_depth){
  tree_depth <- as.integer(tree_depth)
  indices <- sample(1L:9L, 2**tree_depth-1, replace=TRUE)
  thresholds <- trunc(runif(2**tree_depth-1, min=0, max=10)*10) / 10
  gini_gain <- runif(2**tree_depth-1)

  indices[(2**(tree_depth-1)):(length(indices))] <- -1L

  print(indices)
  print(thresholds)
  .Call("test_bfs_q2tree", indices, thresholds, gini_gain, length(indices))
}

test_bfs_q2tree is a C function that essentially looks like this:

SEXP test_bfs_q2tree(SEXP INDICES, SEXP THRESHOLDS, SEXP GINI, SEXP LEN){
  // reconstruct the tree
  SEXP R_ptr = PROTECT(R_get_treeptr(R_NilValue, INDICES, THRESHOLDS, GINI, LEN));

  // get the tree from the R external pointer
  DTN *tree = (DTN *) R_ExternalPtrAddr(R_ptr);

  // print it out
  printDecisionTree(tree);

  // free its memory
  freeDecisionTree(tree);

  // unprotect the R external pointer and return
  UNPROTECT(1);
  return R_NilValue
}

Step 2: Making Decision Tree Nodes

At this point, I have a data structure and a way to read it to/from R. It also can be saved across multiple R sessions. The next step is creating one of the building blocks of decision trees: the nodes it contains.

There are many ways to build decision trees, but the most well-known is the CART (Classification and Regression Trees) algorithm. I first tried to figure out what they’re doing in the randomForest package, but their code is…extremely difficult to understand. In absence of that, I instead just started implementing based on what it should theoretically look like.

The CART algorithm for each node of a classification tree in a random forest is fairly straightforward:

Randomly choose n variables to evaluate
For each variable, determine the split point that maximizes the Gini Gain
Split the data on the variable/threshold combination that maximizes Gini Gain

You can see that a lot of this revolves around the “Gini Gain”, but what exactly is that? Gini Gain is derived from the Gini Impurity, which measures “how often a randomly chosen element of a set would be incorrectly labeled if it were labeled randomly and independently according to the distribution of labels in the set” (Wikipedia, see previous link). The mathematics work out very cleanly, so the expression for Gini Impurity is just:

1 - sum_i(p_i^2)

Here p_i^2 is the probability of each class in the training set, and sum_i is the sum over all categories. Essentially, you take one minus the sum of squared probabilities for each class. The best possible value is 0, when all elements are in the same class.

Gini Gain is then just the Gini Impurity of the total dataset minus the weighted Gini Impurity of each branch after the split. To illustrate this, let’s walk through an example. Suppose I have a set of three classes, {A,B,C}, and my starting dataset is:

{A, A, A, A, B, B, C, C, C}

The gini impurity is then one minus the squared sum of probabilities for each class. The probabilities for A,B,C are 4/9, 2/9, 3/9 (respectively), so the Gini impurity is:

  1 - ((4/9)^2 + (2/9)^2 + (3/9)^2)
= 1 - (16/81 + 4/81 + 9/81)
= 1 - 29/81
= 52/81

That’s about equal to 0.642.

Now, let’s say that we pick some split point that divides our dataset into two groups: {A, A, A, A, | B, B, C, C, C}. The left side has all the elements from classes A, and the right has all from B,C. The Gini Impurity of the right and left are then:

Gini(left):
    1 - ((4/4)^2)
  = 1 - (1^2)
  = 1 - 1
  = 0

Gini(right):
    1 - ((2/5)^2 + (3/5)^2)
  = 1 - (4/25 + 9/25)
  = 1 - 13/25
  = 12/25

Now the Gini Gain of this split is the Gini Impurity at the beginning (0.642) minus the sum of weighted Gini Impurities of the left and right nodes. This weighting is done by the number of elements in each node. In this case, since we split our set of nine elements into two sets of size four and five (resp.), the final calculation is:

Gini Gain:
    GiniImpurity(parent) - (weightedGini(left) + weightedGini(right))
  = 52/81 - ((4/9)(0) + (5/9)(13/25))
  = 52/81 - (0 + 65/225)
  = 52/81 - 13/45
  = 143/405

So our Gini Gain is 143/405, which is about 0.353. By maximizing the Gini Gain, we’ll consistently pick split points that reduce the Gini Impurity as much as possible. This is because the maximizing the Gini Gain corresponds to picking split points wherein the Gini Impurity of the child nodes is smallest relative to the Gini Impurity of the parent.

To illustrate this, if we had picked a partition that split our nodes into {A, A, B, C, C | A, A, B, C}, the Gini Impurity of the child nodes would be 9/25 for the left and 6/16 for the right. Our Gini Gain would be 52/81 - [(5/9)(9/25) + (4/9)(6/16)] = 223/810 = 111.5/810, which is about 0.275. This is a worse score than our previous example, and it corresponds to a case where the elements of the set are much less well separated.

Let’s get back to coding. The first step was making a function to calculate the Gini Impurity of a vector of classes. I chose Fortran for this, since matrix operations are a little easier to write in Fortran.

pure subroutine gini_imp(classes, l, nclass, o_v)
    ! calculate gini impurity of a given vector of classes
    ! variable definitions:
    ! classes: vector of classes (integer, 1:n)
    !       l: length of `classes`
    !  nclass: number of unique classes
    !     o_v: output variable
    use, intrinsic :: iso_c_binding, only: c_int, c_double
    implicit none
    integer(c_int), intent(in) :: l, nclass
    integer(c_int), intent(in) :: classes(l)
    real(c_double), intent(out) :: o_v

    real(c_double) :: class_counts(nclass), total
    integer(c_int) :: i
    if(l == 0) then
      o_v = 1.0
      return
    end if

    ! tabulate number of classes
    do i=1, nclass
      class_counts(i) = 0.0+count(classes==i) ! cast to double for later
    end do

    total = sum(class_counts)

    ! gini impurity is 1 - (squared probabilities)
    o_v = 1.0-sum((class_counts / total)**2)
  end subroutine gini_imp

This gives us a way to calculate the Gini Impurity given a single vector. Now, we just have to apply it to a set of observations to find the optimal split point for a given variable:

pure subroutine find_gini_split(v, response, l, nclass, o_v, o_gini_score) bind(C, name="find_gini_split_")
    ! Variable declarations:
    !            v: vector of values to split on (numeric)
    !     response: classes of each entry
    !            l: length of v and responses
    !       nclass: number of unique classes
    !          o_v: (output) value to split on
    ! o_gini_score: (output) Gini Gain of split
    use, intrinsic :: iso_c_binding, only: c_int, c_double
    implicit none

    integer(c_int), intent(in) :: l, nclass
    integer(c_int), intent(in) :: response(l)
    real(c_double), intent(in) :: v(l)
    real(c_double), intent(out) :: o_gini_score, o_v

    integer(c_int) :: i, mloc
    real(c_double) :: total_gini, gains(l)
    logical :: tmpmask(l)

    ! calculate the base gini impurity
    call gini_imp(response, l, nclass, total_gini)
    gains(:) = total_gini

    ! Calculate the gini gain for every possible split point
    do concurrent(i=1:l)
      tmpmask(:) = v <= v(i)
      if(count(tmpmask) == l) then
        gains(i) = -1.0
      else
        call gini_imp(pack(response, tmpmask), count(tmpmask), nclass, total_gini)
        gains(i) = gains(i) - (total_gini * count(tmpmask)) / l
        tmpmask(:) = .not. tmpmask
        call gini_imp(pack(response, tmpmask), count(tmpmask), nclass, total_gini)
        gains(i) = gains(i) - (total_gini * count(tmpmask)) / l
      end if
    end do

    ! find the best split and the gini gain of that split
    gains = gains / l
    mloc = maxloc(gains, dim=1)
    o_v = v(mloc)
    o_gini_score = gains(mloc)
  end subroutine find_gini_split

This gives us a way to calculate the best split point for a given variable. The final step is just determining what variables to pass to Fortran from C.

void split_decision_node_classif(DTN *node, double *data, int *class_response,
                                  int nrows, int ncols, int nclass, int num_to_check){
  // data should always be a numeric
  // response should be an int ranging from 1:n
  // nclass, num_to_check are constant throughout execution of the program

  // data will be a matrix stored by column (first nrows entries are col1, second are col2, etc.)
  // we'll just assume that all the preprocessing is done in R, no need to fiddle with that here
  // processing the SEXPs will be done separately so we can repeatedly call this internally

  // setting up a random sample of ints
  int *cols = malloc(sizeof(int) * ncols);
  for(int i=0; i<ncols; i++) cols[i] = i;
  int choice, tmp;

  // shuffle the columns, use R's random number generator
  // this is a Fisher-Yates shuffle, for anyone interested
  GetRNGstate();
  for(int i=ncols-1; i>0; i--){
    choice = floor(unif_rand()*i);
    tmp = cols[choice];
    cols[choice] = cols[i];
    cols[i] = tmp;
  }
  PutRNGstate();

  double *results = malloc(sizeof(double) * num_to_check);
  double *gini_gain = malloc(sizeof(double) * num_to_check);
  double curmax = -0.5;
  choice = -1;
  for(int i=0; i<num_to_check; i++){
    // call Fortran to find the best split point
    F77_CALL(find_gini_split)(&data[nrows*cols[i]], class_response, &nrows, &nclass, &results[i], &gini_gain[i]);
    if(gini_gain[i] > curmax){
      choice = i;
      curmax = gini_gain[i];
    }
  }

  // assign the threshold, index, and gini gain to the node
  node->threshold = results[choice];
  node->index = cols[choice];
  node->gini_gain = curmax;

  // cleanup
  free(results);
  free(gini_gain);
  free(cols);
  return;
}

And now we have a way to determine a split point in the nodes. Next up is doing it a bunch of times to generate a full decision tree.

If you actually implement this and try it out, you’ll find a couple issues. First, the runtime is abysmal compared to randomForest. Second, the performance is middling. Third, it only works on classification–Gini Gain isn’t really defined for regression. These aren’t huge issues, though; the priority is getting something working that we can refine later. I’ll come back to optimizing these methods once the whole algorithm is working.

Step 3: Making Decision Trees

The next step is building a decision tree for some input data. My goal is getting a working model, so I’m going to just focus on an easier problem subset. I’ll assume that input data are a matrix of numeric values (double in C), and the output is a vector of integer (int in C) corresponding to which class each row belongs to. This isn’t actually that much of a simplification–R’s formula parsing will transform the inputs into a matrix of numeric values anyway.

We already have a way to calculate a split at each node, so we need to do two more things to make a decision tree:

Create a node object and populate it with the correct split point and index
Split up the matrix of data according to the split point

This function is going to be called recursively, so I’m also going to be sure to call R_CheckUserInterrupt() to make sure that if the user wants to stop early, it actually exits. The code here is going to be into a few parts.

First, let’s do some preliminary checking on the classes themselves. If they’re all the same class, we can just finish. Additionally, if we’re already past the maximum depth specified by the user, we should stop splitting. I’m intentionally going to check if cur_depth == max_depth rather than using cur_depth > max_depth so that we can use max_depth=-1 to have no maximum.

First, let’s call the function we wrote earlier to find a split point:

void learntreeclassif_helper(DTN *node, double *data, int *class_response,
                              int nrows, int ncols, int nclasses, int num_to_check,
                              int cur_depth, int max_depth, int min_nodesize){

  // Error checking and stuff is going to go here
  // ...

  // this will assign the splitpoint and stuff into node
  split_decision_node_classif(node, data, class_response,
                              nrows, ncols, nclasses, num_to_check);

That takes care of (1), so now we need to split up the data and call the function for the node’s children.

  // How big do we need the new arrays to be?

  // get the values we just found
  double splitpoint = node->threshold;
  int ind = node->index;
  double *v = &data[nrows*ind];

  // determine how many rows the data passed to left/right nodes will have
  int nrow_left = 0, nrow_right=0;
  for(int i=0; i<nrows; i++){
    if(v[i] <= splitpoint)
      nrow_left++;
    else
      nrow_right++;
  }

  // allocate space for data and classes
  double *left_data = malloc(sizeof(double) * nrow_left*ncols);
  double *right_data = malloc(sizeof(double) * nrow_right*ncols);
  int *left_class = malloc(sizeof(int) * nrow_left);
  int *right_class = malloc(sizeof(int) * nrow_right);
  int ctr_l=0, ctr_r=0;

  // traverse the data, adding each row to the left or right data matrices
  for(int i=0; i<nrows*ncols; i++){
    if(v[i%nrows] <= splitpoint){
      left_data[ctr_l] = data[i];
      if(ctr_l < nrow_left)
        left_class[ctr_l] = class_response[i%nrows];
      ctr_l++;
    } else {
      right_data[ctr_r] = data[i];
      if(ctr_r < nrow_right)
        right_class[ctr_r] = class_response[i%nrows];
      ctr_r++;
    }
  }

  // create a new left and right node, then call function recursively
  DTN *left_node = initNode();
  DTN *right_node = initNode();

  // left node
  learntreeclassif_helper(left_node, left_data, left_class, nrow_left,
                          ncols, nclasses, num_to_check, cur_depth+1,
                          max_depth, min_nodesize);
  // right node
  learntreeclassif_helper(right_node, right_data, right_class, nrow_right,
                          ncols, nclasses, num_to_check, cur_depth+1,
                          max_depth, min_nodesize);

  node->left = left_node;
  node->right = right_node;

  return;
}

That’s the brunt of the function. If you’ve used C before, you’ll notice a bunch of problems here. First, lots of malloc calls without any free calls. We’ll be leaking memory all over the place. Combine that with the fact that our recursion never ends, and we’ll be crashing CPUs left and right. Since this tutorial is already extremely long, I’m going to omit the code and do what every math student dreams of: leave it as an “exercise to the reader”.

Here’s a sketch of how the function works:

Check if we should stop recursion. More specifically, are the entries all the same class? Are we deeper than the specified max depth? Do we have fewer rows than the nodesize parameter?
Try to split the node
Check if we made a split. If every split increases the Gini Impurity, then we can’t make any more good splits and we should just return.
If we made a split, allocate space for the children nodes and recurse.

The other little blip is the memory (de)allocation. My solution was to free data and classes ASAP in the function itself. Since we copy values into left_data, right_data, left_class, and right_class, we don’t really need data or classes anymore. Copy the data into new containers, free the old ones, pass the new ones to the recursion.

Oh, and we need an R interface:

SEXP R_learn_tree_classif(SEXP DATA, SEXP NROWS, SEXP NCOLS, SEXP CLASSES, SEXP NCLASSES, SEXP TO_CHECK, SEXP MAX_DEPTH, SEXP MIN_NODESIZE){
  // array input
  double *data = REAL(DATA);
  int *class_response = INTEGER(CLASSES);

  // variable inputs
  int nrows = INTEGER(NROWS)[0];
  int ncols = INTEGER(NCOLS)[0];
  int nclasses = INTEGER(NCLASSES)[0];
  int num_to_check = INTEGER(TO_CHECK)[0];
  int max_depth = INTEGER(MAX_DEPTH)[0];
  int min_nodesize = INTEGER(MIN_NODESIZE)[0];

  // internal vars
  DTN *head = initNode();

  // helper function will destroy data and class_response, so duplicate them first
  double *dup_data = malloc(sizeof(double)*nrows*ncols);
  int *dup_class_response = malloc(sizeof(int)*nrows);

  // these do not need to be free'd -- will be free'd in the helper function
  dup_data = memcpy(dup_data, data, sizeof(double)*nrows*ncols);
  dup_class_response = memcpy(dup_class_response, class_response, sizeof(int)*nrows);

  learntreeclassif_helper(head, dup_data, dup_class_response, nrows, ncols, nclasses,
                          num_to_check, 0, max_depth, min_nodesize);

  // now we should have our entire tree created, and our duplicated arrays destroyed.

  // Now let's export it to an R object

  // these objects will be allocated in `export_internal_tree`
  int *indices = NULL;
  double *thresholds = NULL, *gini_gain=NULL;
  int l = 0;
  export_internal_tree(head, &indices, &thresholds, &gini_gain, &l);

  // This is one option, I'm instead just going to register the external
  // pointer right away and return it, since I think that's easier.
  // Avoids a double call, and most people will predict right after
  // training anyway.

  // Read values back into R
  SEXP R_retval = PROTECT(allocVector(VECSXP, 4));
  SEXP R_indices = PROTECT(allocVector(INTSXP, l));
  SEXP R_thresholds = PROTECT(allocVector(REALSXP, l));
  SEXP R_gini = PROTECT(allocVector(REALSXP, l));

  memcpy(INTEGER(R_indices), indices, sizeof(int)*l);
  memcpy(REAL(R_thresholds), thresholds, sizeof(double)*l);
  memcpy(REAL(R_gini), gini_gain, sizeof(double)*l);
  free(indices);
  free(thresholds);

  SET_VECTOR_ELT(R_retval, 1, R_indices);
  SET_VECTOR_ELT(R_retval, 2, R_thresholds);
  SET_VECTOR_ELT(R_retval, 3, R_gini);
  UNPROTECT(3);

  // register the external pointer and then return
  SEXP R_ptr = PROTECT(R_MakeExternalPtr(head, R_NilValue, R_NilValue));

  // R_TreeFinalizer just deallocates all the memory allocated to the decision tree
  R_RegisterCFinalizerEx(R_ptr, (R_CFinalizer_t) R_TreeFinalizer, TRUE);
  SET_VECTOR_ELT(R_retval, 0, R_ptr);
  UNPROTECT(2);

  return(R_retval);
}

Steps 4-7: Making Random Forests

Yes, I’m going to combine these steps into a single section. They’re all quick, so they can be combined.

Making a random forest is pretty simple. Random forest trees are actually easier than single decision trees, since Breiman’s implementation for random forests skips pruning the trees. Thus, we basically just loop from 1:n for n trees, and make each of them with a sample of the data. All we need to do for that is just use sample in R, then pass the values to the C functions we’ve made.

I wish I could write more about formula objects. The truth is, they’re kind of a black box to me. Whenever I work with formulas, I usually just adapt the first few lines of glm() or lm() to parse the formula objects.

parse_formula <- function(formula, data, weights, na.action){
  ## copying a lot of this from glm()
  if(missing(data))
    data <- environment(formula)
  mf <- match.call(expand.dots=FALSE)
  m <- match(c("formula", "data", "subset", "weights", "na.action"),
             names(mf), 0L)
  mf <- mf[c(1L, m)]
  mf$drop.unused.levels <- TRUE
  mf[[1]] <- quote(stats::model.frame)
  mf <- eval(mf, parent.frame())
  if(identical(method, "model.frame"))
    return(mf)
  mt <- attr(mf, 'terms')
  y <- model.response(mf, "any")
  if(length(dim(y)) == 1L){
    nm <- rownames(y)
    dim(y) <- NULL
    if(!is.null(nm))
      names(y) <- nm
  }
  if(!is.empty.model(mt))
    x <- model.matrix(mt, mf, contrasts)
  else
    x <- matrix(NA_real_,nrow(y), 0L)
  weights <- as.vector(model.weights(mf))

  # do other stuff
}

This is roughly how most of R’s base code parses formula objects. At the end of this function, x will store the input data as a numeric matrix with consistent variable names and ordering. Storing the formula will allow us to make similar data structures for predictions:

predict.RandForest <- function(rf, newdata=NULL, na.action=na.pass){
  tt <- terms(attr(rf, 'formula'), data=newdata)
  noData <- (missing(newdata) || is.null(newdata))
  if(noData){
    x <- model.matrix(rf)
    mmDone <- TRUE
    return()
  } else {
    Terms <- delete.response(tt)
    m <- model.frame(Terms, newdata, na.action = na.action)
    x <- model.matrix(Terms, m, contrasts.arg=attr(rf, 'contrasts'))
    mmDone <- FALSE
  }

  nentries <- nrow(x)
  nc <- ncol(x)
  results <- matrix(0.0, nrow=nentries, ncol=length(attr(rf, "class_levels")))
  colnames(results) <- attr(rf, "class_levels")

  # do other stuff
}

Here rf is our model, and the formula object used to generate it is stored as attr(rf, 'formula'). I included the contrasts argument in case I add something that uses it later, but right now it should always be NULL.

Once we’ve parsed the formula into a consistent matrix, we just call our internal functions to build the tree. Prediction is a pretty simple routine as well:

double predict_for_input(DTN *tree, double *data){
  DTN *tmp=tree;

  while(tmp->index != -1){
    if(data[tmp->index] <= tmp->threshold)
      tmp = tmp->left;
    else
      tmp = tmp->right;
  }

  return(tmp->threshold);
}

Step 8: Optimization

So it’s around this time that I decided I’d benchmark the runtime of my implementation against the randomForest package. It turns out that mine is…bad. For evaluating a dataset with 1000 rows, randomForest took around 0.25 seconds, whereas mine took…over 11 seconds. That’s not great.

I decided to take some time to think about this a little more. The crux of the problem is in how we determine split points. This is easily verifiable by just commenting out the logic to find Gini Gain and replacing it with constant assignments that execute (basically) instantly. How would you go about optimizing the previous implementation?

First, some insights. My program runs around 50x slower than randomForest, so this isn’t just a case of using less optimized languages or functions–the algorithm itself is worse. I looked into it a little more, and came up with the following three problems:

find_gini_split calls gini_imp twice per proposed threshold and creates two vectors. That could easily be a single vector and a single function call.
The logic to find a split point just checks for the highest raw Gini Gain. However, a negative Gini Gain means that our split is actually worse than we started. We should be stopping in these cases and just set the node to be a leaf node.
We’re checking every single value in the vector as a possible threshold.

(1-2) are big improvements already–implementing these fixes brought my runtime down to just 0.55 seconds. That’s better, but still double that of randomForest. The scaling of mine is also an issue; my algorithm slows down much faster than that of randomForest.

This is all (likely) because of (3). This implementation checking every possible value in the vector as a threshold is super super inefficient. To see why, here are two examples.

First, imagine the predictor is just a simple true/false value. Our vector of values will be n long, with all values either 0 or 1. My implementation will check n different thresholds, even though we only really need to check a single one (whether or not the value is 0).

Second, imagine the predictor is some bimodal distribution, like sum of distinct normal distributions. Let’s also assume that the modes clearly distinguish between two classes. We’ll try every possible threshold, but we could instead just check the values in the center of the modes. There will be significantly fewer thresholds between the modes, and they’ll also all be better split points than any of the values around the modes.

In essence, I’m hinting at some smarter way to traverse the space. Neural networks often use gradient descent, but we unfortunately do not have access to a closed form solution for the derivative of the Gini Gain. However, we can easily approximate it. I’m not completely sure what the output space looks like, so I’m going to use a simulated annealing approach to traverse the space. In pseudocode, this roughly looks like this:

current_threshold = mean(values)
temp_max = 100
current_gini = gini_imp(currentthreshold)
for i in (temp_max-1:0):
  shouldUpdate = false
  new_threshold = current_threshold + runif()
  new_gini = gini_imp(newthreshold)
  if new_gini < current_gini:
    shouldUpdate = true
  else:
    proposal_chance = exp( (new_gini - current_gini) / (1 - ((i)/tempmax)) )
    roll = runif()
    if roll <= proposal_chance:
      shouldUpdate = true

  if shouldUpdate:
    current_threshold = new_threshold
    current_gini = new_gini

Essentially, move around the space randomly and recalculate the Gini Impurity at the new point. If the Gini Impurity is less (meaning the Gini Gain would be larger), we take that as our new estimate. If the Gini Impurity is greater (Gini Gain would be less, a worse choice), we accept it with a probability proportional to the “temperature”. The temperature isn’t a real temperature, but it’s a parameter that decreases our acceptance probability over time. The algorithm is a simulated version of metals annealing.

Using this, the accuracy of my implementation is roughly the same as randomForest (if not slightly better) on classification tasks with numeric variables. For some reason the accuracy of my algorithm drops significantly when categorical variables are added. I’m not yet quite sure why that happens, but it’s next on my list to investigate.

Conclusion

Conclusion? But we still have so much to go!

Yep. This takes me a while to write, and I’m also not completely done with the code. Code-wise, I’ve roughly completed through (7), but this blog post is already super super long. You can check out the most current state of the code at https://github.com/ahl27/machineRy. I’m planning on updating it as I have time, so stay tuned!

Fortran, C, and R

2024-01-05T00:00:00-05:00

First post of 2024! I wanted to take a little bit of time to talk about using C and Fortran in R. I often feel like the documentation for using C is a little tough to find, and finding out how to call Fortran from R is even harder. Is it even worth it, though? Should you be using Fortran in your R code? And if you could write C, why would you bother with Fortran? Let’s look through them step by step, using two common sorting algorithms (quicksort and mergesort) as examples.

I’m including example code in all three languages, and then I’ll benchmark their relative performance at the end.

Setup

For all of these examples, I’m going to be writing code to sort a vector of integers using either quicksort or mergesort. The setup for these is pretty easy:

len <- 1000L
randvec <- as.integer(sample(1:100, len, replace=TRUE))

We’re preallocating the vector so that when we benchmark, we can ignore the time required to make the testing vector. If you’re unfamiliar with either sorting algorithm, they’re both divide-and-conquer algorithms. Quicksort works by picking a “pivot” and sorting the array such that all values less than the pivot come before it, and all values larger come after. We then recursively apply the same strategy to the values before and after the pivot (picking new pivots) to sort the entire array. Mergesort works by first recursively partitioning the array into smaller and smaller blocks, and then iteratively combining these blocks into sorted order. You can check out example code here, or look at illustrated examples on Wikipedia (Mergesort, Quicksort).

Starting Simple: R Code

If you’re here, you probably already know how to write and execute R code. This is the biggest benefit of R: it’s (by definition) the easiest type of code to write and execute within R. I’m going to use two sorting implementations in R. The first is the built-in sort method, using method='quick' to call quicksort. This is basically just calling C on the backend, so we should expect the performance to be roughly the same as a C implementation.

base_r <- function(){
  sort(randvec, method='quick')
}

Now, I’m also going to add a raw R implementation to see what the difference between the (basically C) base R implementation and typical user-written R code. I’m not guaranteeing this is the most optimal implementation, but it does get the job done.

rquicksort <- function(v){
  l <- length(v)
  if(l <= 2){
    if(l == 2 && v[1] > v[2])
      v <- rev(v)
    return(v)
  }
  pivot <- v[l %/% 2]
  v <- v[-(l%/%2)]
  leftv <- rquicksort(v[v < pivot])
  rightv <- rquicksort(v[v >= pivot])
  c(leftv, pivot, rightv)
}

r_quick <- function(){
  rquicksort(randvec)
}

Moving up: C Code

C code can be called from R in three main ways. The first is to use R code that basically runs C in the background, such as with built-in base functions like sort. However, oftentimes there aren’t base R functions for the use-case you want. In this case, we can write our own functions in C and call them either using .Call or .C. .Call takes in R objects (referred to as SEXP objects) and can return a new SEXP object, whereas .C takes in pointers to the underlying C data behind R code, and modifies these values in-place. Functions called with .C must be void, and are unable to allocate any R objects. Here’s an example of a quicksort algorithm implemented in a C file:

#include <R.h>
#include <Rdefines.h>

// helper functions to be called by the main function (c_quicksort)
inline void swapval(int *vec, int i1, int i2){
  int tmp = vec[i2];
  vec[i2] = vec[i1];
  vec[i1] = tmp;
}

void c_quicksort_helper(int *vec, int n){
  if(n <= 2){
    if (n==2 && vec[1] < vec[0])
      swapval(vec, 0, 1);
    return;
  }
  int pivot = n / 2;
  int pivotval = vec[pivot];
  int tempind = 0;

  // swap out the pivot point to the final element
  swapval(vec, n-1, pivot);

  for(int i=0; i<n-1; i++){
    if(vec[i] < pivotval){
      if(i > tempind) swapval(vec, i, tempind);
      tempind++;
    }
  }

  swapval(vec, tempind, n-1);
  c_quicksort_helper(vec, tempind);
  c_quicksort_helper(vec+tempind+1, n-tempind-1);
}

// note that all the inputs are pointers
void c_quicksort(int *vec, int *n){
  int len = n[0];
  c_quicksort_helper(vec, len);
}

To be able to use this in R, we first have to compile it into a format R can understand. Assuming I saved the above in a file called cquick.c, we can compile it by using R CMD SHLIB cquick.c -o cquick.so on the commandline. This will create a shared object (.so) file called cquick.so in the same directory. Once we’ve done this, we can call it from R with:

# first, load the shared object file
dyn.load('cquick.so')

# this a void function, so we'll call it with .C
c_quick <- function(){
  .C("c_only_quick", randvec, len)[[1L]]
}

Finally, Fortran

C and R are pretty commonly used together, but I personally had quite a bit of trouble figuring out how to add Fortran code to R. The initial appeal of Fortran to me is that Fortran syntax feels a lot like R–it supports slice indexing, vectorized functions, all that good stuff. Unlike C, you don’t have to worry too much about memory or managing pointers. Let’s write a quicksort routine in Fortran first:

subroutine fquicksort(x, n)
  implicit none
  integer, intent(in) :: n
  integer, intent(inout) :: x(n)
  call helpersort(x, n)
end subroutine fquicksort

recursive pure subroutine helpersort(x, n)
  implicit none
  integer, intent(in) :: n
  integer, intent(inout) :: x(n)
  integer :: p, pless, pgr

  ! return if array is less than 3 long
  if(n <= 2) then
    ! if it's 2 long, make sure they're sorted
    if (n == 2 .and. x(2) < x(1)) x(:) = x(2:1:-1)
    return
  end if

  ! pivot here is just the center of the array
  p = x(n/2)

  ! replacing values using pack() -- returns subset of array defined by mask (always 1D)
  x(:) = [pack(x, x < p), pack(x, x==p), pack(x, x > p)]

  ! count up how many we have less than and greater than
  pless = count(x < p)
  pgr = count(x > p)

  ! recursive calls
  call helpersort(x(:pless), pless)
  call helpersort(x((n-pgr+1):), pgr)
end subroutine helpersort

Here we have two subroutines, and if you strip away all the Fortran setup stuff (e.g., variable declaration and function annotations), the result is pretty similar to R code. pack(x, x<p) is equivalent to x[x<p], and the rest is pretty similar to R. If you can write something in R code, it’s (to me at least) much easier to translate it to Fortran than to R.

Now, how do we call it from R? We’re going to compile it the same way, using R CMD SHLIB fquick.f90 -o fquick.so, and then we use almost the same syntax:

# first, load the shared object file
dyn.load('fquick.so')

# this a void function, so we'll call it with .C
fortran_quick <- function(){
  .Fortran("fquicksort", x=randvec, n=len)$x
}

There are two main differences between calling this and calling the C implementation. First, we use .Fortran instead of .C–that difference should be pretty self-explanatory. Second, we provide named arguments and get the returned value with $x. It’s possible to call Fortran code in the same way as .C, using .Fortran('fquicksort', randvec, len)[[1L]], but Fortran also supports providing named arguments. When you do, the returned list will also be named, which lets us get the returned value using $x.

Now, it’s also possible to call Fortran within C code called from R. That seems like it may be overcomplicating things, but often it can be faster to call to Fortran than to callback to R. In the event you need to do something that C doesn’t do super well, it can be useful to make small subroutine calls to Fortran within larger C functions. I’m going to provide a mergesort implementation here that’s called from C–there are a couple things to be aware of when doing this.

First, the Fortran code:

! Fortran subroutine to run mergesort
module fmergemod
  implicit none
  private
  public fmergesort

contains
  pure subroutine fmergesort(x, n) bind(C, name="fmerge")
    ! use c-compatible types
    use, intrinsic :: iso_c_binding, only: c_int
    implicit none
    integer(c_int), intent(in) :: n
    integer(c_int), intent(inout) :: x(n)
    call helpermsort(x, n)
  end subroutine fmergesort

  recursive pure subroutine helpermsort(x, n)
    use, intrinsic :: iso_c_binding
    implicit none
    integer(c_int), intent(in) :: n
    integer(c_int), intent(inout) :: x(n)

    integer(c_int) :: center, temparr(n), il, ir, j

    if(n == 1) return

    ! get the center of current array, may not be exact
    center = n / 2

    ! recursive call on left and right sides
    call helpermsort(x(:center), center)
    call helpermsort(x((center+1):), n-center)

    ! sort the two halves into a complete value
    il = 1
    ir = center+1
    do j=1, n
      if(il > center .or. (ir <= n .and. x(ir) <= x(il))) then
        temparr(j) = x(ir)
        ir = ir+1
      else
        temparr(j) = x(il)
        il = il+1
      end if
    end do

    x(:) = temparr
  end subroutine helpermsort
end module fmergemod

Wrapping subroutines in modules is generally encouraged, so that’s what we’ve done here. A couple things to note:

We have to use C-compatible types, which we do with the iso_c_binding intrinsic. Integer variables are marked with integer(c_int) (other C types are supported in ways you’d expect, e.g., c_double).
We have to make sure the function we’ll call from C is marked as public.
We specify that C-callable functions are bound to C using bind(C, name="xyz"). This makes the function available to C and callable as xyz().

Now we have to call it from C. This code is much shorter:

#include <R.h>
#include <Rdefines.h>

extern void fmerge(int *x, int *n);

SEXP run_fmerge(SEXP VEC, SEXP LEN){
  int *v = INTEGER(VEC);
  int *l = INTEGER(LEN);

  // note that we can only pass POINTERS
  // passing int instead of int * will break
  fmerge(v, l);

  return(VEC);
}

void better_fmerge(int *vec, int *n){
  fmerge(vec, n);
}

I’ve included both an example of using the .Call syntax (run_fmerge) and the .C syntax (better_fmerge). .C is a better approach for this specific example, but using .Call is much more common. Note that we’ve protyped the Fortran function using extern void fmerge(...), and made sure that all the arguments to our Fortran function are pointers. The function itself is defined within Fortran, so we have to compile them together. Let’s assume they’re called fmerge.f90 and fmerge.c, then we make our shared library with R CMD SHLIB fmerge.f90 fmerge.c -o fmerge.so. Once we’ve done that, calling it from R is the same as the C example:

# first, load the shared object file
dyn.load('fmerge.so')

cfortran_merge <- function(){
  .C("better_fmerge", randvec, len)[[1L]]
}

How do they compare?

The real question is, how do they compare? We have five total functions: two in R, one in C, and two in Fortran. Let’s benchmark them with the microbenchmark package (truncating results to just the median and mean):

microbenchmark::microbenchmark(
  fortran_quick(),
  cfortran_merge(),
  c_quick(),
  r_quick(),
  r_default()
)

# Benchmark:
# Unit: microseconds
#          function       mean    median
#   fortran_quick()  137.09334  122.0160
#  cfortran_merge()  100.52134   93.4595
#         c_quick()   28.53928   22.6525
#          r_base()   53.72435   42.8860
#         r_quick() 1478.26484 1249.0240

Now, these aren’t all the same algorithm, but they are relatively comparable in algorthmic complexity. Let’s break down the results, focusing on the median runtimes.

First, c_quick and r_base are almost identical. As mentioned before, R’s sort() function is basically just C anyway, so it’s not surprising that these are about the same. c_quick outperforms r_base because it does less error checking and R callbacks, which save time but make the code less robust. Both flavors of Fortran (fortran_quick, called from R, and cfortran_merge, called from C from R) perform about the same, around 3-6x slower than the C implementation. Finally, the strict R implementation r_quick is by far the slowest, clocking in at roughly 10x slower than the Fortran methods and about 30-50x slower than the C implementations.

After writing this, I found older, much more comprehensive benchmarks that roughly parallel these results: good C code executes roughly 3-4x faster than good Fortran code. You can see lots of languages benchmarked against each other here. Fortran was dropped from the benchmark in 2012, so the newest results are only from 2011.

All this is to say: C is definitely the fastest, and Fortran is relatively close. If you need ultra-high performant code, C is likely your best option. However, if you’re writing code that’s tough to write in C, you can strike a nice balance between performance and ease of coding using Fortran. If you’re a Fortran wizard and can optimize your code more, you can probably approach C performance. I won’t pretend that these are heavily optimized implementations, but they’re good enough to get rough estimates of relative performances.

I feel like people tend to stick too much to the languages they’re familiar with. Having a diverse set of tools in your toolbox gives you more options to attack problems with. Have proficiency in Fortran, C, and R together gives you the ability to maximize runtime without sacrificing too much readibility. Give Fortran a try, you may find that it’s easier than it seems. Happy Coding!

Forth for R

2023-11-27T00:00:00-05:00

I’ve always enjoyed learning about different programming languages. Different languages come with different specialties, paradigms, and constraints. As said in a recent talk at Strange Loop, the languages we know affect how we think about and approach problems.

This effect is especially pronounced in languages with significantly different paradigms. For example, while there are certainly differences between C and C++, their core features are very similar. In contrast, a Haskell specialist will likely have a much different approach to problem solving than a C++ veteran. It’s these languages that introduce totally new ways to write code that really interest me, which brings me to Forth.

Go Forth and code!

If you’ve never heard of Forth, it’s an interesting little language. Like Python, Forth is an interpreted language with a REPL and no enforcement of variable types. Like C, Forth gives you unfettered direct access to your system’s memory, and like Java, it compiles your code on the fly to optimize runtime. Oh, and did I mention it doesn’t have variables? (sort of)

Forth was also released prior to C in 1970. Since then, it has powered several spaceflight missions, the Open Firmware boot system, and many other projects. It also happens to double as an operating system, and is one of the most lightweight languages out there. A complete Forth system (OS, compiler, interpreter, and space for user data) could fit in memory on an 8-bit system. That’s less than 64KB!

Programming languages are typically classified by their features. For example, you’re probably heard of object-oriented programming languages, like Java or Python. Forth falls into a unique little realm of programming languages called “stack-oriented” languages. This is because everything Forth does revolves around a single stack—all your values get pushed to a single stack, and all functions work on that same stack.

Cool! Who cares?

Hopefully at this point, I’ve given a sufficiently good exposition of Forth to make you at least moderately interested in it. I mentioned earlier that using different programming languages helps change how your approach problems. However, one of the largest barriers for me to work in new languages is the entry point. Working in a new language is often frustrating, and experienced programmers usually have a workflow they’re used to for their normal languages.

That’s what I sought to address with the froth package. Rather than making you go out and figure out how to download, install, and start working in Forth, froth lets you work directly in a Forth-like environment from R. You can use all the aspects of R you’re used to (RStudio, R objects, the R profiler, etc.) but still try out working in Forth!

How do I get started?

You can download the froth package from CRAN with

install.packages("froth")

From there, you can enter a Forth environment by just running froth(), and you can quit the environment by typing exit or quit.

What can I do with this?

I’ve shown you how to start a Forth environment in R, but not actually what to do with it. Like I mentioned, Forth is a complete programming language with its own syntax distinct from R. My implementation of froth doesn’t have all the features of full Forth systems, but it has enough to get you started.

The go-to resource for Forth is the Starting Forth textbook. To help you get started, I’ve adapted this book into a tutorial for getting started with froth, which is available on the the package website. I’ll leave you with the go-to first program for any new programming language:

> library(froth)
> froth()
fr> ." Hello, world!\n"
Hello, world!
ok.

Good luck in your Forth journey!

`dendrapply` and How To Contribute to R

2023-11-10T00:00:00-05:00

If you’ve been following my blog posts, you know that I previously refactored R’s dendrapply function. After some initial feedback from R-devel, I was encouraged to apply for the R Project Sprint at the University of Warwick in the UK.

What an incredible experience! I had the opportunity to meet many members of R Core, and got to show my code to people much smarter than me. Most notably, I had the chance to show my dendrapply implementation to the original author of the function, Martin Maechler. I’ve updated my code significantly since then, so I thought it would be a good idea to walk through how people can contribute to R. If you’re just interested in the current state of dendrapply, you can check it out on Bugzilla.

Getting your feet wet

The top advice for people learning a new language is to immerse yourself in it. Surrounding yourself with examples of a new language is incredibly helpful for learning, especially if those examples come from native speakers. The same is undoubtedly true of R; immersing yourself in the R development community helps learn the ins and outs of contribution.

There exist a number of R mailing lists (see here). The most important of these is arguably R-devel, in which developers discuss contributions, bugs, and changes to the main R codebase. This mailing list gets quite a bit of traffic from the R-core team, as well as other excellent developers in the community.

The other main source of information is the codebase itself. R is maintained on subversion, but a mirror of the current codebase is available on GitHub. On there you can see all the internals of R…though if you’re like me, that’s probably quite a lot to take in all at once. Reasonbly good explanations for how the internals work can be found in the Writing R Extensions guide, as well as Hadley Wickham’s guide.

Tracking down the source code

Okay, now we know a little bit about the internals of R. However, the codebase is still enourmous; how do we go about identifying how a particular part of R works?

If we’re looking at R code, the process is relatively simple. From within R, you can typically view the source code for a given method by just typing the name of the method without (). For example:

> lapply
function (X, FUN, ...)
{
    FUN <- match.fun(FUN)
    if (!is.vector(X) || is.object(X))
        X <- as.list(X)
    .Internal(lapply(X, FUN))
}
<bytecode: 0x11d0e6798>
<environment: namespace:base>

In this case, typing lapply returns the internal definition of the function, as well as the namespace it lives in (in this case, base). Most of the builtin R namespaces can be found within /src/library–for example, base is found in /src/library/base, and the code for lapply is found in /src/library/base/R/lapply.R.

Unfortunately, lapply calls .Internal(lapply(X, FUN)), which means there’s also some C code to be analyzed. C code can be tricker to track down, but most of it is found in /src/main. On the command line, we can use grep to search for lines within files. Let’s try looking for the source code for lapply:

bash$ grep -n -e "lapply" src/main/*

src/main/apply.c:33:/* .Internal(lapply(X, FUN)) */
src/main/apply.c:41:attribute_hidden SEXP do_lapply(SEXP call, SEXP op, SEXP args, SEXP rho)
src/main/builtin.c:1047:  /* There is a complication: if called from lapply
src/main/coerce.c:1977:    necessarily correct, e.g. when called from lapply() */
src/main/deparse.c:918:   // := structure(lapply(slotNms, slot, object=s), names=slotNms)
src/main/envir.c:3023: * Equivalent to lapply(as.list(env, all.names=all.names), FUN, ...)
src/main/logic.c:479:        One exception is perhaps the result of lapply, but
src/main/names.c:658:{"lapply", do_lapply,  0,  10, 2,  {PP_FUNCALL, PREC_FN, 0}},
src/main/saveload.c:2314: val <- lapply(list, get, envir = envir)
src/main/saveload.c:2318:   Unfortunately, this will result in too much duplication in the lapply

-n tells grep to return line numbers, and -e tells it to use a regular expression. You can also use the -r flag to search recursively through directories.

In this case, we get a bunch of values returned. Most of them are comments, but two of these lines are important. src/main/names.c:658:... tells us that, on line 658 of src/main/names.c, the call .Internal(lapply(...)) calls do_lapply. It just so happens that the definition of do_lapply can be found on line 41 of src/main/apply.c, as shown by our grep call. If we wanted to investigate further, we could open those files and look at what’s going on internally.

Reporting bugs

Now we sort of understand R and can find the source code for a given function. The process for fixing bugs looks like the following:

Make sure the bug is actually a bug
Make absolutely sure the bug is real
Make sure you can reproduce the bug on current R with a clean environment
Do 1-3 again
Check with the community to make sure you did (1-3) right
Report the bug on Bugzilla, potentially with a patch

If it isn’t apparent, be really sure you’ve actually found a bug and haven’t just done something dumb (like the one time I accidentally overwrote the value of c). If you’re unsure, you can ask on the R Contributors Slack channel or email r-devel. Once you have a bug and can reproduce it, use Bugzilla to report the bug along with a minimal working reproduction of the problem.

If you’ve cloned the r-source repository, you can create a patch by first changing the codebase, then using git diff upstream/master > PatchFile.diff. This will create a patch file called PatchFile.diff with your changes. Before submitting, make sure to test your patch! The easiest way to do this is with Docker, though if you have a Linux machine you should be able to do this without spinning up a VM. You can download the most up-to-date R source and apply your patch with:

svn checkout https://svn.r-project.org/R/trunk`
cd trunk
svn patch /path/to/PatchFile.diff
./configure --with-readline=no --with-x=no --without-recommended-packages && make
./bin/R

The second to last line builds R, and the last one runs your (patched) version of R. This often requires a lot of dependencies; you can use a prebuilt docker container I’ve created that has them all installed with these commandline commands:

docker pull peiple/r-sandbox
docker run -it --rm -v /PATH/TO/LOCAL/PATCH/FILE:/UserData peiple/r-sandbox

This will drop you in a Linux VM with all dependencies already installed, and then you can svn checkout and svn patch as normal.

The state of `dendrapply`

dendrapply has been updated and uploaded to Bugzilla (see here). This version has a lot of bugfixes as compared to the code uploaded in my original blog post, and should be ready for integration into R. Since it’s a relatively large change, the review process takes a while–I’m talking with R-core about what the best decision is regarding dendrapply. We may instead end up refactoring it into an R implementation (without C code) if some proposed changes from Luke Tierney are integrated. TBD!

Refactoring R's `dendrapply`

2023-02-23T00:00:00-05:00

As someone who specializes in comparative phylogenomics, I work a lot with phylogenetic trees. Trees are represented in R as dendrogram objects, which are essentially a series of nested lists. Each “node” of the tree is a list with multiple members (two if a binary tree, but dendrogram objects are not constrained to be binary), each of which is another dendrogram object. The leaves are special cases in that they have length 1 and an additional property leaf, which is set to TRUE.

R has a number of functions called apply functions, whose primary purpose is to apply a function to a set of things in a particular way. Commonly used examples are lapply to apply a function over a list-like object, tapply to apply a function to a set of objects grouped based on a factor, rapply to recursively apply a function to an object, or apply to apply a function to a matrix/array.

dendrapply is a special type of apply statement intended specifically for applying functions to dendrogram objects. The main requirement is to recursively apply a function to each node of the tree. While this may sound like a task for rapply, rapply is more intended to apply a function to non-list elements of a nested list, while dendrapply is intended to apply the function to all nodes in the list. This means that dendrapply specializes in applying the function to internal nodes of the tree, whereas rapply applies the function only to the leaves (and doesn’t always preserve the original structure).

dendrapply is currently implemented recursively, which has led to some users experiencing issues from stack overflows resulting from deep recursion on trees with many nodes (at least in users’ reports on DECIPHER). Additionally, the recursive implementation makes the function slow for trees with many internal nodes. rapply avoids this issue by factoring out the recursion internally, which gave me the idea to try to implement an optimized version of dendrapply.

Implementation

My focus for this implementation was removing the recursive calls in dendrapply. The final implementation is only a modest runtime improvement, but this can hopefully be optimized prior to the final release.

The full implementation is written in C, which makes a lot of things easier at the cost of a few things becoming really hard. The algorithm proceeds as follows:

copytree = copy(input_dend)

initialize LinkedList
add root node to LinkedList

ptr = head(LinkedList)
while ptr is not NULL:
  if node has children:
    for child in ptr.node.children:
      insert child in next position
  else:
    while(node has no unevaluated children):
      apply function to node
      merge node into parent
      node = parent
      ptr = parent.ptr

  ptr = ptr.next

return head(LinkedList).node

It’s a little hard to write out, so I’ll use a small example to showcase. Imagine we have a dendrogram with two leaves, and we want to apply a function f to each node a,b,c.

Tree:

    a
   / \
  b   c

Initialize LL:

HEAD -> NULL


Add root node:

HEAD -> a -> NULL


Set ptr to head:

HEAD -> a* -> NULL


Iterate over linked list:

HEAD -> a* -> c -> NULL             (insert child, back to front to ensure correct traversal)
HEAD -> a* -> b -> c -> NULL        (insert child)
HEAD -> a -> b* -> c -> NULL        (increment pointer)
HEAD -> a -> B* -> c -> NULL        (b has no children; apply f, f(b)=B)
HEAD -> aB* -> c -> NULL            (merge B into parent)
HEAD -> aB -> c* -> NULL            (a has an unevaluated child, so increment pointer)
HEAD -> aB -> C* -> NULL            (apply f to c, f(c) = C)
HEAD -> aBC* -> NULL                (merge C into parent)
HEAD -> ABC* -> NULL                (a has no unevaluated children so apply f, f(a)=A)
HEAD -> ABC -> NULL*                ( done, return ABC )

This implementation achieves the same result as a recursive operation, but doesn’t run the risk of overflowing the stack for deep trees. Note that this algorithm is a post-order traversal; pre-order is the default and is discussed later.

Details and Difficulties

There are a few things about the implementation of this that make things difficult. First, the R garbage collector likes to collect R objects while they’re being worked on in C. We can get around this by using PROTECT() to tell the garbage collector not to touch the object, but the protection stack has a fixed size that is extremely small (10,000 items by default). The tree as a whole can be protected when it’s first loaded, but calling f() on a node of the tree produces a new R object that is unprotected, so we have to protect the result.

The naive approach is to just put all the nodes into a linked list, apply the function to every node, then rebuild the tree. Unfortunately, this rapidly exhausts the available space we have on the protection stack. Instead, we have to work slightly smarter.

We can get around this issue by immediately assigning the value of f(node) to the parent node. If the parent node is protected, the value assigned to it will be protected as well. This means that, as long as we ensure the parent is always protected, we don’t need any extraneous protection calls. Some clever shuffling can ensure that we protect everything under the first PROTECT call on the entire tree.

I’ve implemented two methods for dendrapply: a pre-order traversal and a post-order traversal. The final implementation for both uses a maximum of 3 slots on the protection stack, and no recursive function calls. The original tree consumes the first PROTECT call, which protects all its children until they’re modified. When each node is evaluated, we use a PROTECT call to create the R expression to be called and a second to protect the SEXP returned from the function. This value is then assigned to the parent node using SET_VECTOR_ELT, which protects the value. Since protection is by value and not by reference, we can safely store this new value in the linked list. Applying the function to the root can safely be done by using REPROTECT() to preserve protection on children.

The result is a little funky in the pre-order case: we use VECTOR_ELT on the parent to get the node, call the function on it, replace the node using SET_VECTOR_ELT on the parent, and then populate the reference in the linked list by calling VECTOR_ELT on the parent a second time. This ensures we always have protected values.

With a post-order traversal, the implementation is a little cleaner. Since the children of each node are always evaluated prior to the node itself, we don’t need to recall VECTOR_ELT after calling the function. Instead, we can just merge the nodes and continue.

The main difference for end users between the two traversals is that, for a given node n, pre-order traversal will always evaluate f(n) before any of its children, whereas post-order traversal will always evaluate f(n) after all of its children. Pre-order is the default for backwards compatibility with the original stats::dendrapply, which used a pre-order traversal. The post-order method allows for some new functions, such as the following:

f <- function(x){
  if(!is.null(attr(x, 'leaf'))){
    v <- as.character(attr(x, 'label'))
  } else {
    v <- paste0(attr(x[[1]], 'newattr'), attr(x[[2]], 'newattr'))
  }
  attr(x, 'newattr') <- v
  x
}

This function assigns a new attribute equal to the label if it’s a leaf, or the concatenation of the child nodes’ new attributes if it’s an internal node. The default application of dendrapply will only create new attributes for the leaves, and will return character(0) for any internal nodes (since the children won’t have had their new attribute set yet). However, using how='post.order' will ensure we evaluate the children first, meaning that internal nodes will be assigned a non-empty value:

# dendrogram with 3 leaves and two internal nodes
dend <- as.dendrogram(hclust(dist(1:3)))

# original dendrapply from `stats`
stats::dendrapply(dend, exFunc)
attr(dend, 'newattr')
# > character(0)

# pre-order (default)
dendrapply(dend, exFunc, how='pre.order')
attr(dend, 'newattr')
# > character(0)

# post-order
new_dendrapply(dend, exFunc, how='post.order')
attr(dend, 'newattr')
# > "312"

This capability is something I have found myself wishing for often in dendrapply. Calculating Fitch Parsimony for a phylogeny is a great example of a method that relies upon a post-order traversal.

Replicating Bugs

Another weird thing I had to contend with is ensuring that the functionality exactly replicates that of the current dendrapply so as not to break existing packages. I’m reminded of this tweet:

Users tend to do things with code the developers never expect, which is exactly how I found myself failing all build checks repeatedly when trying to integrate my code into my fork of the R codebase. It turns out, at one point, a test was added to ensure dendrapply performs expectedly when doing the following operation:

> D <- as.dendrogram(hclust(dist(cbind(setNames(c(0,1,4), LETTERS[1:3])))))
> dendrapply(D, labels)

[[1]]
[1] "C"

[[2]]
[[2]][[1]]
[1] "A"

[[2]][[2]]
[1] "B"


[[3]]
[1] "C"

“Expectedly” means producing the output shown. This was surprising to me, because this dendrogram is fully bifurcating. Additionally, labels(D) produces c("C", "A", "B"), so it’s not even that we performed labels() on the root node and then replaced the first and second entries with the result of their children. It turns out that, due to the way the original dendrapply was coded, the results of each operation replicate if they’re not large enough to fill the list generated by the parent. This means that, after applying labels() to the root node, we get a list with 3 elements. Then, when we apply labels to the children, we get two new values. The parent list has three values, so we replicate those values as many times as necessary. In this case, the result of the children are the first two entries shown above. Since the list has length 3, we replicate the first element to the third location, producing the output given.

According to the tests, many CRAN packages rely on this bug working as “expected”. This required a bit of a code refactor, but I did manage to get my C code to replicate values across the parent array to accurately reproduce this bug. Knowing how software development is, I’m sure that I’ll have to do something similar for future bugs people are relying on…but that’s an issue for another day.

Tentative Future Additions

A inorder traversal is definitely possible, but I’m not sure if it’s worth it. The implementation would use the almost same code as the post-order case, although nodes would be added by inserting the right element next and the left element at the end of the list. In-order traversal on a multifurcating tree is defined as evaluating all but the last child node, then the node, then the final (rightmost) child. I can’t think of a good use case for this type of traversal, especially for multifurcating trees.

Breadth-first traversals are also easily implementable by making elements insert at the end of the linked list rather than at the next position. However, the behavior of these can be a little odd with dendrogram objects (the result is fairly counterintuitive to me at least). These may be worth exploring as options in the future.

Something I would like to implement is a “flat” application of dendrapply, similar to the flexibility offered in rapply. Providing an option to get the results as a flat list/vector could have very good usecases. To illustrate what this would look like, imagine the following tree with shown labels:

     a
   /   \
  b     c
 / \   / \
e   f g   h

I’d like the function to be able to do something like:

> dendrapply(exTree, \(x) attr(x, 'label'), how='post.order', flatten=TRUE)
[1] "e" "f" "b" "g" "h" "c" "a"

> dendrapply(exTree, \(x) attr(x, 'label'), how='pre.order', flatten=TRUE)
[1] "a" "b" "e" "f" "c" "g" "h"

Note that this is different from dendrapply in that the result is a flat vector and not a nested list, and different from rapply in that the result is the function applied to leaves and internal nodes. Adding breadth-first and in-order traversals would likely be more useful for this kind of function than for the standard dendrapply.

Benchmarking

Speed gains from this implementation are relatively modest, although I suspect that further optimization could improve runtime. As the main improvement of this is in the backend and not the R function calls themselves, it should have relatively consistent performance regardless of the input function. Testing was performed on a simple function to add an attribute to each node, as well as a recursive one that calls rapply at every node. Speedup is relatively consistent regardless of function, with the average boost in runtime approximately 1.5-3x on my machine (2021 MacBook Pro, M1 Pro, 32GB RAM). Calling rapply had less of a speedup compared to faster functions, likely because the runtime of the called R function dominates the overall runtime of the dendrapply call. Benchmarking using a minimal function to measure only the impact of the new apply function resulted in an average speedup of 2.5-3x depending on tree size. Looking at the memory usage of the functions, my new implementation has significantly decreased usage due to fewer function call frames allocated on the stack. However, this is difficult to benchmark since the original function uses R to allocate memory and the new function allocates in C.

Compatibility with the previous version of dendrapply was tested against the unit tests available in dendextend, one of the largest packages that makes extensive usage of stats::dendrapply in a variety of scenarios. The pre-order traversal version passed all unit tests.

Post-order failed many tests because methods in dendextend depend on the pre-order traversal order–this is why pre-order is the default setting.

Complete Code:

The complete code is available on Github. What follows are some comments on the code contained within the files.

R Script

Link to R Script

This has some quirks to make it a drop-in replacement for stats::dendrapply. The behavior of the original function when the provided function does not return a dendrogram or list-like object is a little counterintuitive to me, but after lots of testing this implementation should replicate it all accurately. There is a weird quirk where calling VECTOR_ELT on an SEXP seems to unclass the object, and I was running into problems with the input nodes not being of type dendrogram. I thought it was fairly safe to just reclass the object as 'dendrogram' when it comes to the function, since we expect to be applying the function to dendrogram objects anyway (and children of a dendrogram should also be dendrogram).

C Code

Link to C code

The C code is much longer. The main functions exposed to R are do_dendrapply() via .Call interface, and free_dendrapply_list() via .C interface. The brunt of the computation is done in new_apply_dend_func, which will likely be either renamed in the future or rolled into do_dendrapply(). Note that checking for leaf nodes depends on the leaves having correct values for attr(node, 'leaf'); if someone messes with the nodes it could perform unexpectedly. The current implementation defines leaves as nodes such that attr(node, 'leaf')==TRUE and non-leaves as is.null(attr(node, 'leaf')) || attr(node,'leaf')==FALSE. It’s unfortunately not possible to just check for nodes with length 1, since we should be able to support dendrograms with arbitrary numbers of children at internal nodes (whether that’s 1, 2, or many). I regard this error as being in the same category as users being able to change S3 classes to arbitrary values–it’s known and documented that things could go wrong if users mess with the values, and those that choose to modify the values are proceeding at their own risk. I’m not completely sure what the function will do in this scenario–I believe it will probably run infinitely until the C memory limit is exceeded. I’ve added enough checks to ensure that the function execution is always rescuable via user interrupts, so I think this is overall okay.

Aidan Lakshman's R Blog

The ExoLabel Post: Clustering Massive Networks with Limited Resources

The Problem

The Solution

Performance

Deep Dive: How does it really work?

Step 1: Reindexing

Step 2: Recording edges

Step 3: Sorting

Step 4: Clustering

Step 5: Output

Conclusion

Converting vectors to dendrograms in R

Setup

What makes a dendrogram?

Building the nested list structure

Fixing the nodes

Conclusion

Automated R Testing and Coverage on GitHub (without Codecov!)

My solution: a custom workflow

Main output

Expanded table

Some failing tests

Failing test detail

How does it work?

Conclusion

Writing a Random Forest from Scratch

Step 0: Planning

Step 1: Internal Architecture

Step 2: Making Decision Tree Nodes

Step 3: Making Decision Trees

Steps 4-7: Making Random Forests

Step 8: Optimization

Conclusion

Fortran, C, and R

Setup

Starting Simple: R Code

Moving up: C Code

Finally, Fortran

How do they compare?

Forth for R

Go Forth and code!

Cool! Who cares?

How do I get started?

What can I do with this?

`dendrapply` and How To Contribute to R

Getting your feet wet

Tracking down the source code

Reporting bugs

The state of dendrapply

Refactoring R's `dendrapply`

Implementation

Details and Difficulties

Replicating Bugs

Tentative Future Additions

Benchmarking

Complete Code:

R Script

C Code

The state of `dendrapply`