1
$\begingroup$

The following code comes from OEIS A000311 which is labeled phylogenetic trees. The function mtot enumerates the labeled trees.

size=4;
sps[{}] := {{}};
sps[set : {i_, ___}] := 
  Join @@ Function[s, Prepend[#, s] & /@ sps[Complement[set, s]]] /@ 
    Cases[Subsets[set], {i, ___}];
mtot[m_] := 
  Prepend[Join @@ 
    Table[Tuples[mtot /@ p], {p, 
      Select[sps[m], 1 < Length[#] < Length[m] &]}], m];
Table[Length[mtot[Range[n]]], {n, 1, size}]

(*Labeled trees*)
mtot[Range[4]]
>{{1,2,3,4},{{1},{2},{3,4}},{{1},{2,3},{4}},{{1},{2,4},{3}},{{1},{2,3,4}},
{{1},{{2},{3,4}}},{{1},{{2,3},{4}},{{1},{{2,4},{3}}},{{1,2},{3},{4}},
{{1,2},{3,4}},{{1,3},{2},{4}},{{1,3},{2,4}},{{1,4},{2},{3}},{{1,4},{2,3}},
{{1,2,3},{4}},{{{1},{2,3}},{4}},{{{1,2},{3}},{4}},{{{1,3},{2}},{4}},
{{1,2,4},{3}},{{{1},{2,4}},{3}},{{{1,2},{4}},{3}},{{{1,4},{2}},{3}},
{{1,3,4},{2}},{{{1},{3,4}},{2}},{{{1,3},{4}},{2}},{{{1,4},{3}},{2}}}

What I need is an fast method of enumerating unlabeled trees. See OEIS A000669 While the labeled trees can be used to find the unlabeled trees, it is very inefficient.

(*Unlabeled trees*)
{{o,o,o,o},{o,o,{o,o}},{o,{o,o,o}},{o,{o,{o,o}}},{{o,o},{o,o}}}

(*Number of first 6 enumerated labeled trees*)
{1,1,4,26,236,2752,39208,660032};

(*Number of first 6 enumerated unlabeled trees*)
{1,1,2,5,12,33,90,261};
Improve this question
$\endgroup$
8
  • $\begingroup$ Can you clarify what a "phylogenetic tree" means in this context? I assume it means a rooted tree, which can be encoded as a directed tree with edges oriented away from the root? Is your problem equivalent to finding all non-isomorphic directed trees on $n$ vertices? $\endgroup$
    – Szabolcs
    Commented Aug 24, 2022 at 10:54
  • $\begingroup$ Also, what do you mean by "enumerating"? Do you mean merely counting (the word is sometimes used in this sense in math) or generating each and every instance (which is the more general meaning)? $\endgroup$
    – Szabolcs
    Commented Aug 24, 2022 at 10:55
  • $\begingroup$ If we only wanted to generate unlabelled undirected trees, we could use the geng utility from the nauty suite. It can generate all unlabelled graphs with $n$ vertices and $m$ edges, with certain constraints. If we want trees, we can ask for connceted graphs with $n$ vertices and $n-1$ edges. For example, with $n=7$, use Import["!geng 7 6 -c", "Graph6"]. You may need to put the absolute path to geng for your system. $\endgroup$
    – Szabolcs
    Commented Aug 24, 2022 at 10:59
  • 1
    $\begingroup$ Getting directed trees from this is not entirely trivial. For each undirected tree, we can orient edges away from each vertex, obtaining $n$ directed trees. However, some of these will still be isomorphic, and will need to be filtered out. With this method, I get this for 4 vertices: i.sstatic.net/fc8B8.png These are 4 trees, but you claim 5. What is missing? There are no other directed out-trees on 4 vertices, only these. $\endgroup$
    – Szabolcs
    Commented Aug 24, 2022 at 11:08
  • 1
    $\begingroup$ For your convenience, implementation using my IGraph/M package: Function[n, Catenate[ Function[tree, DeleteDuplicatesBy[IGOrientTree[tree, #] & /@ VertexList[tree], CanonicalGraph]] /@ IGImport[ "!/opt/local/bin/geng " <> IntegerString[n] <> " " <> IntegerString[n - 1] <> " -c", "Nauty"]]] Remember to edit the path to geng for your system. $\endgroup$
    – Szabolcs
    Commented Aug 24, 2022 at 11:09

1 Answer 1

Reset to default
1
$\begingroup$

I don't know how to avoid "collisions" when building unlabeled trees from subtrees, and naively tried wrapping your functions with DeleteDuplicates.

spsu[{}] := {{}};
spsu[set_] := spsu[set] =
  DeleteDuplicates@(Sort/@(Join@@Function[s, Prepend[#, s] & /@ spsu[Table[a,Length@set-Length@s]]] /@ 
    (Table[a,#]&/@Range@Length@set)));

mtotu[m_] := mtotu[m]=
  DeleteDuplicates@(Sort/@(Prepend[Join @@ 
    Table[Tuples[mtotu /@ p], {p, 
      Select[spsu[m], 1 < Length[#] < Length[m] &]}], m]));

and the performance is not too bad,

Table[Length[mtotu[Table[a,n]]], {n, 1, 14}]//Timing
(*{0.182161, {1, 1, 2, 5, 12, 33, 90, 261, 766, 2312, 7068, 21965, 
  68954, 218751}}*)

comparing with the labeled ones,

Table[Length[mtot[Range[n]]], {n, 1, 8}]//Timing
(*{17.6373, {1, 1, 4, 26, 236, 2752, 39208, 660032}}*)

Here the standard trick

foo[x_]:=foo[x]=...

is to memorize old results of recurrsion.

enter image description here

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.