# 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(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;