# count words of length n over an alphabet of m elements
# that avoid a given set of patterns

EN :=
proc(n, patlist, m)
option remember;
local ind, d, res, pos, patind, pat, patpos, len;
    res := 0;

    for ind from m^n to 2*m^n-1 do
        d := convert(ind, base, m);

        for patind to nops(patlist) do
            pat := patlist[patind];
            len := nops(pat);

            for pos from 0 to n-len do
                for patpos to len  do
                    if d[pos+patpos] <> pat[patpos] then
                        break;
                    fi;
                od;

                if patpos = len+1 then
                    break;
                fi;
            od;

            if pos < n-len+1 then
                break;
            fi;
        od;

        if patind = nops(patlist)+1 then
            res := res + 1;
        fi;
    od;

    res;
end;

# if you have StringTools available you can use this version
# alphabet size max 100 characters

with(StringTools);

EN2 :=
proc(n, patlist, m)
option remember;
local ind, d, res, regex, pat2str;
    res := 0;

    pat2str :=
    pat -> cat(seq(sprintf("%02d", q), q in pat));

    regex :=
    Join(map(pat2str, patlist), "|");

    for ind from m^n to 2*m^n-1 do
        d := convert(ind, base, m);

        if not RegMatch(regex, pat2str(d[1..n])) then
            res := res + 1;
        fi;
    od;

    res;
end;


# none of these patterns are subpatterns of another
TREE :=
proc(patlist)
option remember;
local rtnode, pat, pos, cur;

    rtnode := table();

    for pat in patlist do
        cur := eval(rtnode); prev := FAIL;

        for pos to nops(pat) do
            if type(cur[pat[pos]], `table`) then
                cur := eval(cur[pat[pos]]);
            else
                break;
            fi;
        od;

        while pos <= nops(pat) do
            cur[pat[pos]] := table();

            cur := eval(cur[pat[pos]]);
            pos := pos + 1;
        od;
    od;

    rtnode;
end;

TREEPRNT :=
proc(tree)
local recprint;

    recprint :=
    proc(mytree, depth)
    local letter, spc;

        for letter in [indices(mytree, `nolist`)] do
            for spc to depth do printf("  "); od;

            printf("%d\n", letter);
            recprint(mytree[letter], depth+1);
        od;
    end;

    recprint(tree, 0);
end;

TREEVARS :=
proc(tree)
local res, coll, subtr;

    res := [];

    coll :=
    proc(mytree, sofar)
    local letter;
        subtr := [indices(mytree, `nolist`)];

        if nops(subtr) = 0 then
            res := [op(res), [Q[op(sofar)], `leaf`]];
        else
            res := [op(res), [Q[op(sofar)]]];
        fi;

        for letter in subtr do
            coll(mytree[letter], [op(sofar), letter]);
        od;
    end;

    coll(tree, []);
    return res;
end;

TREELOOKUP :=
proc(tree, prefix, pos := 1)
    if pos > nops(prefix) then
        return Q[op(prefix)];
    fi;

    if type(tree[prefix[pos]], `table`) then
        return
        TREELOOKUP(tree[prefix[pos]], prefix, pos+1);
    fi;

    return FAIL;
end;

GFNC :=
proc(initpatlist, m, disp := false)
option remember;
local patlist, issubpat, pat, patx, prefstr, letter,
    node, nodevar, tree,
    allvars, lookup, trans, onetrans, matchinit, sysright,
    sys, fromvar, tovar, avoid, pos, sol;

    if nops(patlist) = 0 then return 1/(1-m*z) fi;

    patlist := [];

    issubpat :=
    proc(p1, p2)
    local pos, len1, len2, scn;

        len1 := nops(p1); len2 := nops(p2);

        if len1 > len2 then return false; fi;

        for pos to len2-len1+1 do
            for scn from 0 to len1-1 do
                if p1[scn+1] <> p2[pos+scn] then
                    break;
                fi;
            od;

            if scn = len1 then return true fi;
        od;

        return false;
    end;

    for pat in sort(initpatlist,
                    (p1, p2)-> nops(p1)<nops(p2)) do
        for patx to nops(patlist) do
            if issubpat(patlist[patx], pat) then
                break;
            fi;
        od;

        if patx > nops(patlist) then
            patlist := [op(patlist), pat];
        fi;
    od;

    if type(disp, boolean) and disp then
        print(patlist);
    fi;

    trans := table();

    tree := TREE(patlist);
    allvars := TREEVARS(tree);

    for node in allvars do
        onetrans := table();

        nodevar := node[1];
        if nops(node) = 2 then
            for letter from 0 to m-1 do
                onetrans[letter] := nodevar;

                if type(disp, boolean) and disp then
                    print(nodevar, letter, nodevar);
                fi;
            od;
        else
            for letter from 0 to m-1 do
                prefstr := [op(nodevar), letter];

                for matchinit to nops(prefstr) do
                    lookup :=
                    TREELOOKUP(tree,
                               prefstr[matchinit..-1]);

                    if lookup <> FAIL then
                        onetrans[letter] := lookup;
                        break;
                    fi;
                od;

                if lookup = FAIL then
                    onetrans[letter] := Q[];
                fi;

                if type(disp, boolean) and disp then
                    print(nodevar, letter,
                          onetrans[letter]);
                fi;
            od;
        fi;

        trans[nodevar] := eval(onetrans);

        sysright[nodevar] := 0;
    od;

    for node in allvars do
        fromvar := node[1];

        for letter from 0 to m-1 do
            tovar := trans[fromvar][letter];

            sysright[tovar] :=
            sysright[tovar] + z*fromvar;
        od;
    od;

    sys := [];

    for node in allvars do
        tovar := node[1];

        if tovar = Q[] then
            sys := [op(sys), Q[]-1 = sysright[tovar]];
        else
            sys := [op(sys), tovar = sysright[tovar]];
        fi;
    od;

    sol := solve(sys, [seq(v[1], v in allvars)]);

    avoid := add(q, q in select(v->nops(v)=1, allvars));
    simplify(subs(op(1, sol), op(1, avoid)));
end;


X := (n, patlist, m) -> coeftayl(GFNC(patlist, m), z=0, n);

VERIF :=
proc()
local checks, item;

    # these checks include pattern sets where a pattern
    # is contained in another
    checks :=
    [[[[0,0,1,1,0,0,2]], 3,
      1/(z^7-3*z+1)],
     [[[0,1,1,0]], 2,
      -(z^3+1)/(z^4-z^3+2*z-1)],
     [[[1,0,0,1,1,1,0,0]], 3,
      (z^5+1)/(z^8-3*z^6+z^5-3*z+1)],
     [[[0,1,0,1,0,1]], 3,
      (z^4+z^2+1)/(z^6-3*z^5+z^4-3*z^3+z^2-3*z+1)],
     [[[0,1,1,0], [1,0,0,1]], 3,
      -(z^3+z^2+1)/(z^4+2*z^3-z^2+3*z-1)],
     [[[0,1,1,0], [1,0,0,1]], 2,
      -(z^3+z^2+1)/(z^3-z^2+2*z-1)],
     [[[0,1,1,0], [0,0], [1,1], [1,0,0,1]], 2,
      GFNC([[1,1], [0,0]], 2)],
     [[[0,0,0,1,1], [1,0], [0,1,1]], 4,
      GFNC([[0,1,1], [1,0]], 4)]
    ];

    for item in checks do
        if factor(GFNC(item[1], item[2])-item[3]) <> 0
        then
            return item;
        fi;
    od;

    true;
end;