17
\$\begingroup\$

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 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.

\$\endgroup\$
  • \$\begingroup\$ Is this code-golf or code-challenge? \$\endgroup\$ – qwr Feb 26 at 4:20
  • 2
    \$\begingroup\$ It's a code-golf challenge: the shortest code wins. But I expect that the shortest solution might be quite long, as in this answer to a previous code-golf challenge. \$\endgroup\$ – Peter Kagey Feb 26 at 5:06
  • \$\begingroup\$ Can you provide a reference implementation or some pseudocode? \$\endgroup\$ – S.S. Anne Feb 27 at 21:44
  • 1
    \$\begingroup\$ I don't know this stuff so I probably won't be able to do it. Can you maybe tell how you did it by hand? \$\endgroup\$ – S.S. Anne Feb 27 at 22:06
  • 1
    \$\begingroup\$ Monomino. Do do do-do-do. ♫♪ \$\endgroup\$ – mbomb007 Mar 3 at 22:09
8
+250
\$\begingroup\$

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's 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
gap> I(4,5,10);
21430

The \$n=7\$ computation already takes several minutes. My computations also agree with the other results in the table.

| improve this answer | |
\$\endgroup\$
  • 1
    \$\begingroup\$ Pretty awesome! \$\endgroup\$ – Anush Feb 28 at 18:43
  • \$\begingroup\$ I'm blown away by this. Even if someone writes something faster for the current bounty, I'll make another one to give to you. \$\endgroup\$ – Peter Kagey Feb 28 at 20:42
  • \$\begingroup\$ This appears to work for polyhedra and tilings of the plane too? \$\endgroup\$ – Peter Kagey Feb 28 at 20:53
  • \$\begingroup\$ @PeterKagey Yes, since all the groups are automatic. \$\endgroup\$ – Christian Sievers Feb 28 at 21:34

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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