Impress Donald Knuth by counting polyominoes on the hyperbolic plane

Question

This challenge is inspired by a talk about Schläfli symbols, etc that I gave in a Geometry seminar. While I was putting together this challenge, I saw that Donald Knuth himself was interested in (some subset of) this problem. In October 2016, he commented on a related OEIS sequence:

If [the OEIS author] is wrong about the hyperbolic {4,5} pentominoes, the next number is probably mistaken too. I don't have [time] right now to investigate further.

Successful completion of this challenge will have you investigating something that Donald Knuth might have investigated if only he had more time, and will result in new additions (and perhaps a rare correction) to the On-Line Encyclopedia of Integer Sequences.

---

Challenge

This code-golf challenge will have you create a function that counts "free polyforms" on the hyperbolic plane. In particular, you will write a function that takes three positive integer parameters p, q, and n and counts the number of \$n\$-cell "free polyforms" on the tiling of the hyperbolic plane given by the Schläfli symbol \$\{p,q\}\$.

Shortest code wins.

---

Definitions

The Schläfli symbol \$\{p,q\}\$ describes a tiling of the hyperbolic plane by \$p\$-gons, where each vertex touches exactly \$q\$ of the polygons. As an example, see the Wikipedia page for the \$\{4,5\}\$ tiling that Donald references above.

A free polyform is a collection of regular polygons that meet at their edges, counted up to rotation and reflection.

---

Input

You can assume that the values of p and q which define the tiling indeed describe an actual tiling of the hyperbolic plane. This means that \$p \geq 3\$, and

• when \$p = 3\$, \$q \geq 7\$,
• when \$p = 4\$, \$q \geq 5\$,
• when \$p = 5\$, \$q \geq 4\$,
• when \$p = 6\$, \$q \geq 4\$, and
• when \$p \geq 7\$, \$q \geq 3\$.

---

Data

OEIS sequence A119611 claims that f(4,5,n) = A119611(n), but Donald Knuth disputes the reasoning for the value of \$A119611(5)\$. (When I counted by hand, I got Knuth's answer, and I've included it in the table below.)

| p | q | n | f(p,q,n)
+---+---+---+---------
| 3 | 7 | 1 | 1
| 3 | 7 | 2 | 1 
| 3 | 7 | 3 | 1 
| 3 | 7 | 4 | 3 
| 3 | 7 | 5 | 4
| 3 | 7 | 6 | 12
| 3 | 7 | 7 | 27
| 3 | 9 | 8 | 82
| 4 | 5 | 3 | 2
| 4 | 5 | 4 | 5
| 4 | 5 | 5 | 16
| 6 | 4 | 3 | 3
| 7 | 3 | 1 | 1
| 7 | 3 | 2 | 1
| 7 | 3 | 3 | 3
| 8 | 3 | 3 | 4
| 9 | 3 | 3 | 4

Note: these values are computed by hand, so let me know if you suspect any mistakes.

Final notes

The output of this program will result in quite a lot of new, interesting sequences for the OEIS. You are of course free to author any such sequences—but if you're not interested, I'll add the values you compute to the Encylopedia with a link to your answer.

Answer 1

GAP and its kbmag package, 711 682 658 bytes

Note that the kbmag package consists not only of GAP code, it contains C programs that have to be compiled (see the package's README file).

LoadPackage("kbmag");I:=function(p,q,n)local F,H,R,r,s,x,c;F:=FreeGroup(2);s:=F.1;r:=F.2;R:=KBMAGRewritingSystem(F/[s^2,r^p,(s*r)^q]);AutomaticStructure(R);H:=SubgroupOfKBMAGRewritingSystem(R,[r]);AutomaticStructureOnCosets(R,H);x:=w->ReducedCosetRepresentative(R,H,w);c:=function(n,U,S,P)local N,Q,Z;if n=0 then Z:=Set(U,t->Set(U,p->(p/t)));return 1/Size(SetX(Union(Z,Set(Z,Q->Set(Q,q->(MappedWord(q,[s,r],[s,r^-1]))))),[1..p],{Q,i}->Set(Q,q->x(q*r^i))));fi;if P=[]then return 0;fi;N:=P[1];Q:=P{[2..Size(P)]};Z:=Filtered(Set([1..p],i->x(s*r^i*N)),w->not w in S);return c(n,U,S,Q)+c(n-1,Union(U,[N]),Union(S,Z),Union(Q,Z));end;return c(n,[],[r/r],[r/r]);end;

This is the result of removing indentation and newlines from this version, and some inlining:

LoadPackage("kbmag");
I:=function(p,q,n)
  local F,G,H,R,r,s,x,c;
  F:=FreeGroup(2);
  s:=F.1;r:=F.2;
  G:=F/[s^2,r^p,(s*r)^q];
  R:=KBMAGRewritingSystem(G);
  AutomaticStructure(R);
  H:=SubgroupOfKBMAGRewritingSystem(R,[r]);
  AutomaticStructureOnCosets(R,H);
  x:=w->ReducedCosetRepresentative(R,H,w);
  c:=function(n,U,S,P)
    local N,Q,Z;
    if n=0 then 
      Z:=Set(U,t->Set(U,p->(p/t)));
      Z:=Union(Z,Set(Z,Q->Set(Q,q->(MappedWord(q,[s,r],[s,r^-1])))));
      Z:=SetX(Z,[1..p],{Q,i}->Set(Q,q->x(q*r^i)));
      return 1/Size(Z);
    fi;
    if P=[]then return 0;fi;
    N:=P[1];Q:=P{[2..Size(P)]};
    Z:=Filtered(Set([1..p],i->x(s*r^i*N)),w->not w in S);
    return c(n,U,S,Q)+c(n-1,Union(U,[N]),Union(S,Z),Union(Q,Z));
  end;
  return c(n,[],[r/r],[r/r]);
end;

If the line containing {Q,i}-> doesn't work, your GAP is too old. You can then replace that line with:

Z:=SetX(Z,[1..p],function(Q,i)return Set(Q,q->x(q*r^i));end);

Several of the Set operations could be slightly faster List operations (the improved version at least uses that it is a set for even more golfing and a little speed compensation), but that would cost one byte each time.

And yes, Knuth' and your result is confirmed:

gap> Read("i.gap");
─────────────────────────────────────────────────────────────────────────────
Loading  kbmag 1.5.9 (Knuth-Bendix on Monoids and Automatic Groups)
by Derek Holt (https://homepages.warwick.ac.uk/staff/D.F.Holt/).
Homepage: https://gap-packages.github.io/kbmag
─────────────────────────────────────────────────────────────────────────────
gap> I(4,5,5);
16
gap> I(4,5,6);
55
gap> I(4,5,7);
224
gap> I(4,5,8);
978
gap> I(4,5,9);
4507

The \$n=7\$ computation already takes several minutes.