4
$\begingroup$

I want to know:

How many "unique" hexagonal tiles can be created with two paths exiting on each edge?

There will always be only 6 paths (connecting two different exits) per tile.

Note: No duplicate tiles. Meaning, if you were to rotate the tile in any orientation it would not be the same as another.

$\endgroup$
  • $\begingroup$ Are the left path and the right path on any one edge distinct? (that is, if I switch the path links on one edge, is that a different tile? $\endgroup$ – Joffan Jan 14 '17 at 14:19
  • 1
    $\begingroup$ Please clarify, perhaps with several pictures. Can paths cross? Can a path join the two exits on one side? Do reflections count as symmetries? Are two paths that exit on the same side but at different exits different? $\endgroup$ – Ethan Bolker Jan 14 '17 at 14:19
2
$\begingroup$

This problem is a case of Power Group Enumeration in the sense of the paper by Fripertinger which was discussed quite extensively at the following MSE link. The set of values consists of the possible edges and is being permuted by the rotations of the hexagon, call this $G$. Edges are represented by products $A_p A_q$ where $p$ and $q$ range from zero to eleven and correspond to a clockwise enumeration of the exits and there are no edges between adjacent exits (same edge). This is a feature of the problem which is open to debate and which I hope I have interpreted correctly. The slots are simply six slots being permuted by the symmetric group $S_6.$ The technique is exactly the same as at the quoted link -- note that we seek sets of edges and not multisets which simplifies things considerably. In a nutshell we consider pairs $(\beta,\alpha)$ of permutations from the edge permutations $G$ and the symmetric group $S_6$ and compute the generating function that corresponding to all possible ways of covering $\alpha$ with cycles from $\beta.$ At the end we extract those terms that contain every exit exactly once. A remarkable feature of this problem is that we are working with generating functions here but the generating function that appears when we try to cover $a_1^6$ with cycles (fixed points) from $a_1^{60}$ produces a completely unmanageable number of terms which it is impossible to process. Fortunately the contribution of this term can be computed in closed form. It has no symmetries and simply counts all tiles before symmetry. As we must exclude edges between adjacent exits we get by inclusion-exclusion

$$\bbox[5px,border:2px solid #00A000]{ \sum_{k=0}^6 {6\choose k} (-1)^k \frac{(12-2k)!}{2^{6-k} (6-k)!} = 6040.}$$

We simply wire this value into the program and detect $a_1^{60}$ during the Power Group Enumeration computation. This is all we need to be aware of at this time and the answer is

$$\bbox[5px,border:2px solid #00A000]{1060.}$$

The reader is invited to verify this result by classifying tiles according to their symmetries and counting the number of tiles in every class.

I also verfied this by a total enumeration routine which in fact does not require all that much time / space and confirms the above findings. PGE obviously generalizes while simple enumeration does not.

This was the Maple code.

with(combinat);

pet_autom2cyclesA :=
proc(src, aut)
local numa, numsubs, marks, pos, cycs,
    data, item, cpos, clen;

    numsubs := [seq(src[k]=k, k=1..nops(src))];
    numa := subs(numsubs, aut);

    marks := Array([seq(true, pos=1..nops(aut))]);

    cycs := []; pos := 1; data := [];

    while pos <= nops(aut) do
        if marks[pos] then
            clen := 0; item := []; cpos := pos;

            while marks[cpos] do
                marks[cpos] := false;
                item := [op(item), aut[cpos]];

                cpos := numa[cpos];
                clen := clen+1;
            od;

            cycs := [op(cycs), clen];
            data := [op(data), item];
        fi;

        pos := pos+1;
    od;

    return [data, mul(a[cycs[k]], k=1..nops(cycs))];
end;


pet_cycleind_symm :=
proc(n)
local p, s;
option remember;

    if n=0 then return 1; fi;

    expand(1/n*add(a[l]*pet_cycleind_symm(n-l), l=1..n));
end;


edges_all_src :=
proc()
option remember;
local edges;

    edges :=
    add(add(A[p]*A[q], q=p+1..11), p=0..11)
    - add(A[2*p]*A[2*p+1], p=0..5);

    [seq(p, p in edges)];
end;

pet_perms_edge_cind :=
proc()
option remember;
local cind, p, q, perm, sl,
    edges, edgeperm, rotind;

    edges := edges_all_src();

    cind := [];

    for rotind from 0 to 5 do
        sl :=
        [seq(A[p]=A[(p+2*rotind) mod 12], p=0..11)];
        edgeperm := subs(sl, edges);

        cind :=
        [op(cind), pet_autom2cyclesA(edges, edgeperm)];
    od;

    cind;
end;

tiles :=
proc()
option remember;
local slot_idx, edge_idx, gf, var, flat, cycs,
    edge_term, slot_term, contrib, cover, deg, onesize;

    slot_idx := pet_cycleind_symm(6);
    edge_idx := pet_perms_edge_cind();

    gf := 0;

    for slot_term in slot_idx do
        for edge_term in edge_idx do
            if edge_term[2] = a[1]^60 then
                next;
            fi;

            if type(edge_term[2]/slot_term,
                    `monomial`) then
                contrib := 1;

                for var in indets(slot_term) do
                    cycs :=
                    select(c->nops(c)=op(1,var),
                           edge_term[1]);

                    onesize := 0;
                    deg := degree(slot_term, var);

                    for cover in choose(cycs, deg) do
                        onesize := onesize
                        + deg!*op(1,var)^deg*
                        mul(mul(el, el in cyc),
                            cyc in cover);
                    od;

                    contrib := contrib*onesize;
                od;

                gf := gf + lcoeff(slot_term)*contrib;
            fi;
        od;
    od;

    gf := expand(gf);

    for var from 0 to 11 do
        gf := coeff(gf, A[var], 1);
    od;

    (gf + 6040)/6;
end;

enum_all_symm :=
proc()
option remember;
local recurse, count, edges, orbits;

    edges := edges_all_src();
    orbits := table();

    recurse :=
    proc(sofar, sel, n, pos)
    local orbit, sl, rotind;

        if n = 6 then
            count := count + 1;

            orbit := {};

            for rotind from 0 to 5 do
                sl :=
                [seq(A[p]=A[p+2*rotind mod 12],
                     p=0..11)];

                orbit :=
                {op(orbit), subs(sl, sel)};
            od;

            orbits[orbit] := 1;

            return;
        fi;

        if pos > nops(edges) then
            return;
        fi;

        recurse(sofar, sel, n, pos+1);

        if nops(indets(sofar*edges[pos])) =
        2*(n+1) then
            recurse(sofar*edges[pos],
                    {op(sel), edges[pos]},
                    n+1, pos+1);
        fi;
    end;

    count := 0;
    recurse(1, {}, 0, 1);

    [count, nops([indices(orbits)])];
end;

Addendum Mon Jun 26 2017. Presenting a completely reworked algorithm and implementation, which gives an instant answer. The previous version computed the entire generating function in the variables representing the exits, expanding intermediate terms even including those that did not contribute. As indicated this algorithm breaks down when placing cycles corresponding to $a_1^{60}$ on $a_1^6.$ The new version uses

$$[z^k] \prod_{q\in C} (1+zq)$$

to represent a choice of $k$ cycles from a set of cycles $C$ and does not expand this term, which means that the contribution from $a_1^{60}$ only consists of $60$ terms as opposed to ${60\choose 6},$ which is not feasible. We thus get a product of these (times a leading coefficient) when there exists a covering of the slot permutation $\alpha$ by cycles from the edge permutation $\beta,$ where $k$ is the number of cycles of a given size in $\alpha$ and $C$ are the cycles of that size from $\beta,$ which is not a conjugacy class in this problem but an actual permutation of the edges. Having constructed this product we differentiate with respect to all variables in sequence and set them to zero thereafter, which isolates the contribution from those terms where each exit occurs just once. We extract the coefficients that correspond to the desired power of $[z^k]$ at the very end, producing a number which gives the possible coverings of $\alpha$ by cycles from $\beta$ that contribute to the count of admissible tiles. The Maple code was as follows (the enumeration routine has also been improved.) We omit the prefix that is shared with the first version.

tiles :=
proc()
option remember;
local slot_idx, edge_idx, slot_term, edge_term,
    cycs, deg, gf, var, res;

    slot_idx := pet_cycleind_symm(6);
    edge_idx := pet_perms_edge_cind();

    res := 0;

    for slot_term in slot_idx do
        for edge_term in edge_idx do
            if type(edge_term[2]/slot_term,
                    `monomial`) then
                gf := 1;

                for var in indets(slot_term) do
                    cycs :=
                    select(c->nops(c)=op(1,var),
                           edge_term[1]);

                    deg := degree(slot_term, var);

                    gf := gf*deg!*op(1, var)^deg
                    *mul(1+z[op(1, var)]*mul(el, el in cyc),
                         cyc in cycs);
                od;

                for var from 0 to 11 do
                    gf :=
                    subs(A[var] = 0, diff(gf, A[var]));
                od;

                for var in indets(slot_term) do
                    gf :=
                    coeftayl(gf, z[op(1, var)]=0,
                             degree(slot_term, var));
                od;

                res := res + lcoeff(slot_term)*gf;
            fi;
        od;
    od;

    res/nops(edge_idx);
end;

enum_all_tiles :=
proc()
option remember;
local recurse, count, edges, orbits, sl;

    edges := edges_all_src();
    orbits := table();

    sl :=
    [seq([seq(A[p]=A[p+2*r mod 12], p=0..11)],
         r=1..5)];

    recurse :=
    proc(sofar, sel, n, pos)
    local orbit, rotind;

        if n = 6 then
            count := count + 1;

            orbit := [sel];

            for rotind to 5 do
                orbit :=
                [op(orbit),
                 subs(sl[rotind], sel)];
            od;

            orbits[sort(orbit)[1]] := 1;

            return;
        fi;

        if pos > nops(edges) then
            return;
        fi;

        recurse(sofar, sel, n, pos+1);

        if nops(indets(sofar*edges[pos])) =
        2*(n+1) then
            recurse(sofar*edges[pos],
                    {op(sel), edges[pos]},
                    n+1, pos+1);
        fi;
    end;

    count := 0;
    recurse(1, {}, 0, 1);

    [count, numelems(orbits)];
end;

Addendum Wed Jun 28 2017. We present the case of arbitrary polygonal tiles having $q$ sides rather than hexagonal ones to complete this discussion and end on a challenge to the reader. We get by inclusion-exclusion for the count with no symmetries the formula

$$\bbox[5px,border:2px solid #00A000]{ \sum_{k=0}^q {q\choose k} (-1)^k \frac{(2q-2k)!}{2^{q-k} (q-k)!}.}$$

Here we choose the $k$ spots where there is an edge between adjacent exits (which we are wanting to avoid), for a factor of ${q\choose k}.$ This leaves $2q-2k$ exits. We choose two of these to connect by an edge, then another two from the remaining exits, and another two, and so on, for a multinomial coefficient ${2q-2k\choose 2,2,\ldots,2}.$ Here we may choose one set of edges in $(q-k)!$ ways, hence the formula. We obtain the sequence starting at $q=1$:

$$0, 2, 8, 60, 544, 6040, 79008, 1190672, 20314880, 387099936,\ldots$$

Taking symmetries into account yields the following sequence:

$$0, 2, 4, 22, 112, 1060, 11292, 149448, 2257288, 38720728\ldots$$

and the challenge to the reader is of course to compute more terms for the latter. This is the Maple code:

edges_all_src :=
proc(q)
option remember;
local edges;

    edges :=
    add(add(A[p]*A[r], r=p+1..2*q-1), p=0..2*q-1)
    - add(A[2*p]*A[2*p+1], p=0..q-1);

    [seq(p, p in edges)];
end;

pet_perms_edge_cind :=
proc(q)
option remember;
local cind, perm, sl,
    edges, edgeperm, rotind;

    edges := edges_all_src(q);

    cind := [];

    for rotind from 0 to q-1 do
        sl :=
        [seq(A[p]=A[(p+2*rotind) mod 2*q], p=0..2*q-1)];
        edgeperm := subs(sl, edges);

        cind :=
        [op(cind), pet_autom2cyclesA(edges, edgeperm)];
    od;

    cind;
end;

tiles :=
proc(q)
option remember;
local slot_idx, edge_idx, slot_term, edge_term,
    cycs, deg, gf, var, res;

    slot_idx := `if`(q=1, [a[1]], pet_cycleind_symm(q));
    edge_idx := pet_perms_edge_cind(q);

    res := 0;

    for slot_term in slot_idx do
        for edge_term in edge_idx do
            if type(edge_term[2]/slot_term,
                    `monomial`) then
                gf := 1;

                for var in indets(slot_term) do
                    cycs :=
                    select(c->nops(c)=op(1,var),
                           edge_term[1]);

                    deg := degree(slot_term, var);

                    gf := gf*deg!*op(1, var)^deg
                    *mul(1+z[op(1, var)]*mul(el, el in cyc),
                         cyc in cycs);
                od;

                for var from 0 to 2*q-1 do
                    gf :=
                    subs(A[var] = 0, diff(gf, A[var]));
                od;

                for var in indets(slot_term) do
                    gf :=
                    coeftayl(gf, z[op(1, var)]=0,
                             degree(slot_term, var));
                od;

                res := res + lcoeff(slot_term)*gf;
            fi;
        od;
    od;

    res/nops(edge_idx);
end;

tiles_all :=
q -> add(binomial(q,k)*(-1)^k*(2*q-2*k)!/2^(q-k)/(q-k)!,
         k = 0..q);

enum_tiles_all :=
proc(q)
option remember;
local recurse, count, edges, orbits, sl;

    edges := edges_all_src(q);
    orbits := table();

    sl :=
    [seq([seq(A[p]=A[p+2*r mod 2*q], p=0..2*q-1)],
         r=1..q-1)];

    recurse :=
    proc(sofar, sel, n, pos)
    local orbit, rotind;

        if n = q then
            count := count + 1;

            orbit := [sel];

            for rotind to q-1 do
                orbit :=
                [op(orbit),
                 subs(sl[rotind], sel)];
            od;

            orbits[sort(orbit)[1]] := 1;

            return;
        fi;

        if pos > nops(edges) then
            return;
        fi;

        recurse(sofar, sel, n, pos+1);

        if nops(indets(sofar*edges[pos])) =
        2*(n+1) then
            recurse(sofar*edges[pos],
                    {op(sel), edges[pos]},
                    n+1, pos+1);
        fi;
    end;

    count := 0;
    recurse(1, {}, 0, 1);

    [count, numelems(orbits)];
end;

Addendum Fri Jun 30 2017. The data for dihedral symmetries being taken into account (rotational and reflectional) are as follows:

$$0, 2, 4, 19, 80, 638, 6054, 76692, 1137284, 19405244,\ldots $$

Addendum Mon Jul 3 2017. It appears that plain Burnside is still the best approach. This requires that we compute the number of tiles fixed by each of the $q$ rotations including the identity, which fixes all tiles. These are counted by the inclusion-exclusion formula given above. For the remaining rotations we have that they must be constant on the cycles (obtained by factorizing the corresponding permutation of edges). This means that to be fixed by a given rotation a cycle of edges is either switched on or off (all edges simultaneously). We use a backtracking search to determine which cycles may be switched on at the same time without creating conflict (more than one edge incident on the same exit.) This lets us calculate three more values for rotational symmetries and we obtain

$$0, 2, 4, 22, 112, 1060, 11292, 149448, 2257288, 38720728, \\ 740754220, 15648468804, 361711410384, \ldots$$

We also find that we have effectively solved the problem for tiles whose number of sides is a prime. We find (more of these can be computed)

$$2, 4, 112, 11292, 740754220, 361711410384, 222595582448849152, \\ 258327454310582805036, 661821993709898403923269564, \\ 10266982973657640119698928948136690256,\ldots$$

The Maple code for this goes as follows.

with(combinat);

pet_autom2cyclesA :=
proc(src, aut)
local numa, numsubs, marks, pos, cycs,
    data, item, cpos, clen;

    numsubs := [seq(src[k]=k, k=1..nops(src))];
    numa := subs(numsubs, aut);

    marks := Array([seq(true, pos=1..nops(aut))]);

    cycs := []; pos := 1; data := [];

    while pos <= nops(aut) do
        if marks[pos] then
            clen := 0; item := []; cpos := pos;

            while marks[cpos] do
                marks[cpos] := false;
                item := [op(item), aut[cpos]];

                cpos := numa[cpos];
                clen := clen+1;
            od;

            cycs := [op(cycs), clen];
            data := [op(data), item];
        fi;

        pos := pos+1;
    od;

    return [data, mul(a[cycs[k]], k=1..nops(cycs))];
end;


edges_all_src :=
proc(q)
option remember;
local edges;

    edges :=
    add(add(A[p]*A[r], r=p+1..2*q-1), p=0..2*q-1)
    - add(A[2*p]*A[2*p+1], p=0..q-1);

    [seq(p, p in edges)];
end;

tiles_no_symm :=
q -> add(binomial(q,k)*(-1)^k
         *(2*q-2*k)!/2^(q-k)/(q-k)!, k=0..q);

bs_tiles :=
proc(q)
option remember;
local res, sl, recurse, edgecycs, cind, vsets,
    edges, edgeperm, rotind, seen, factored;

    edges := edges_all_src(q);

    res := tiles_no_symm(q);

    recurse :=
    proc(cycs, sofar, pos)
    local data, nxt;

        if nops(sofar) = 2*q then
            return 1
        fi;

        if pos > nops(cycs) then
            return 0
        fi;

        data := recurse(cycs, sofar, pos+1);

        if nops(cycs[pos] intersect sofar) = 0 then
            data := data +
            recurse(cycs, cycs[pos] union sofar, pos+1);
        fi;

        return data;
    end;

    cind := [];

    seen := table(); 
    for rotind to q-1 do
        sl :=
        [seq(A[p]=A[(p+2*rotind) mod 2*q], p=0..2*q-1)];

        edgeperm := subs(sl, edges);

        cind :=
        [op(cind),
         pet_autom2cyclesA(edges, edgeperm)];
    od;

    for factored in cind do
        if not(type(seen[factored[2]], `integer`)) then
            vsets :=
            map(indets,
                select(cf -> { seq(degree(cf, v), v in indets(cf)) }
                       = { 1 },
                       map(cyc -> mul(el, el in cyc), factored[1])));

            seen[factored[2]] := recurse(vsets, {}, 1);
        fi;

        res := res + seen[factored[2]];
    od;

    res/q;
end;

With Burnside we also get three more terms for dihedral symmetry, which yields

$$ 0, 2, 4, 19, 80, 638, 6054, 76692, 1137284, 19405244, \\ 370597430, 7825459362, 180862277352,\ldots$$

The reason why the above code for cyclic symmetry is structured the way it is becomes apparent when we study the code for dihedral symmetry, which is why I decided to present it here, omitting duplicate code.

edges_all_src :=
proc(q)
option remember;
local edges;

    edges :=
    add(add(C[p]*C[r], r=p+1..2*q-1), p=0..2*q-1)
    - add(C[2*p]*C[2*p+1], p=0..q-1);

    subs([seq(C[2*p]=A[p], p=0..q-1),
          seq(C[2*p+1]=B[p], p=0..q-1)],
         [seq(p, p in edges)]);
end;

tiles_no_symm :=
q -> add(binomial(q,k)*(-1)^k
         *(2*q-2*k)!/2^(q-k)/(q-k)!, k=0..q);

bs_tiles_dh :=
proc(q)
local res, sl, recurse, cind, vsets,
    edges, edgeperm, rotind, seen, factored;

    edges := edges_all_src(q);

    res := tiles_no_symm(q);

    recurse :=
    proc(cycs, sofar, pos)
    local data, nxt;

        if nops(sofar) = 2*q then
            return 1
        fi;

        if pos > nops(cycs) then
            return 0
        fi;

        data := recurse(cycs, sofar, pos+1);

        if nops(cycs[pos] intersect sofar) = 0 then
            data := data +
            recurse(cycs, cycs[pos] union sofar, pos+1);
        fi;

        return data;
    end;

    cind := [];

    seen := table();
    for rotind from 0 to q-1 do
        if rotind >= 1 then
            sl :=
            [seq(A[p]=A[(p+rotind) mod q], p=0..q-1),
             seq(B[p]=B[(p+rotind) mod q], p=0..q-1)];

            edgeperm := subs(sl, edges);

            cind :=
            [op(cind),
             pet_autom2cyclesA(edges, edgeperm)];
        fi;

        sl :=
        [seq(A[p]=B[q-1-((p+rotind) mod q)], p=0..q-1),
         seq(B[p]=A[q-1-((p+rotind) mod q)], p=0..q-1)];

        edgeperm := subs(sl, edges);

        cind :=
        [op(cind),
         pet_autom2cyclesA(edges, edgeperm)];
    od;

    for factored in cind do
        if not(type(seen[factored[2]], `integer`)) then
            vsets :=
            map(indets,
                select(cf -> { seq(degree(cf, v), v in indets(cf)) }
                       = { 1 },
                       map(cyc -> mul(el, el in cyc), factored[1])));

            seen[factored[2]] := recurse(vsets, {}, 1);
        fi;

        res := res + seen[factored[2]];
    od;

    res/q/2;
end;
$\endgroup$
1
$\begingroup$

If the paths cannot cross, there are a rather limited number of tiles under the constraints given; I make it 5:

tile 1 tile 2 tile 3 tile 4 tile 5

$\endgroup$
  • $\begingroup$ Jordan, crossing paths is accepted. And, what did you use to create those images? $\endgroup$ – Erik Miller Jan 14 '17 at 17:18
  • 1
    $\begingroup$ @ErikMiller Those images were made in Powerpoint, which has a nice "save as picture" option. $\endgroup$ – Joffan Jan 14 '17 at 17:26

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.