# More efficient Omnibus number determination?

Amusing myself with concepts from "Omnibus Sequences, Coupon Collection, and Missing Word Counts", in particular the sequences.

To paraphrase the concept, a string is k-Omni over some alphabet a if any string of length k (or less) from the alphabet can be found as a sequence of the string.

e.g.,

string={5, 4, 0, 5, 3, 3, 1, 4, 0, 2, 4, 0, 2, 3, 5, 0, 0, 0, 5, 4, 2, 3, 3, 5, 5, 4, 1, 5, 5, 4, 4, 5, 3, 2, 1, 3, 1, 2, 2, 4}


is 2-Omni over the alphabet of the string, and 4-Omni over a restricted alphabet of {1,2,3}.

I'm using

kOmni = Block[{f = Total@BitSet[0, DeleteDuplicates@#1], z, cnt = 0},
Fold[If[(z = BitAnd[f, BitSet[#, #2]]) == f, cnt++; 0, z] &, 0, #2];cnt] &


which takes the alphabet and string as arguments, to determine the k for various conditions, e.g. kOmni[{1, 2, 3}, string] returns the desired 4 result.

Might there be a more efficient way to do this? You can assume strings (and alphabets) are limited to non-negative integers, and alphabets are almost always under 200 distinct values, but the strings can be quite large (>10^5 elements).

Update: An optimization I came up with nodding off...

kOmniO = Block[{f, z, cnt = 0, s = #2, a = DeleteDuplicates@#1},
s = Join[a, s];
s = s[[Sort@(Join @@
GatherBy[Range@Length@s, s[[#]] &][[;; Length@a, 2 ;;]])]];
f = Total@BitSet[0, a];
Fold[If[(z = BitSet[#, #2]) == f, cnt++; 0, z] &, 0, s];
cnt] &


About 50% faster for full alphabet, and with alphabet that is a subset of string alphabet, can be over an order of magnitude faster. I still have a gut feeling there's a faster/smarter way to do this... c'mon wizards ;-)

-
Sorry to be dense but I don't understand your example. What are the 4-Omni strings for alphabet {1, 2, 3}? –  Mr.Wizard Jun 26 '14 at 0:59
@Mr.Wizard:Tuples[{1, 2, 3}, {4}]... And @@ (LongestCommonSequence[#, string] == # & /@ Tuples[{1, 2, 3}, {#}]) & /@ {4, 5} -> {True,False} So, the string in the example has all of those tuples of length 4 as subsequences, and it is 4-omni (not the subsequences themselves). –  ciao Jun 26 '14 at 1:04
@Mr.Wizard: To clarify, as a sequence of the string in Mathematica terminology (vs subsequence). –  ciao Jun 26 '14 at 1:31
Got it; I was thinking contiguous sequence and I couldn't see it. Now your function makes more sense. :-) –  Mr.Wizard Jun 26 '14 at 1:40
@Mr.Wizard: Yeah, I realized after the fact I used the mathematical terminology in my reply - has always irked me a bit MMA didn't name them "LongestCommonSequence" and "LongestCommonContiguousSequence"... –  ciao Jun 26 '14 at 1:46

I dont know how to solve your question,but I know that just compile it will save some times.

Clear["Global*"]
string = {5, 4, 0, 5, 3, 3, 1, 4, 0, 2, 4, 0, 2, 3, 5, 0, 0, 0, 5, 4,
2, 3, 3, 5, 5, 4, 1, 5, 5, 4, 4, 5, 3, 2, 1, 3, 1, 2, 2, 4};
kOmni = Block[{f = Total@BitSet[0, DeleteDuplicates@#1], z, cnt = 0},
Fold[If[(z = BitAnd[f, BitSet[#, #2]]) == f, cnt++; 0, z] &, 0, #2]; cnt] &;
kOmni2 = Compile[{{substring, _Integer, 1}, {string, _Integer, 1}},
Module[{f, z = 0, cnt = 0},
f = Total@BitSet[0, DeleteDuplicates@substring];
Fold[If[(z = BitAnd[f, BitSet[#, #2]]) == f, cnt++; 0, z] &, 0, string]; cnt
]
];
Do[kOmni[{1, 2, 3}, string], {5000}] // Timing
Do[kOmni2[{1, 2, 3}, string], {5000}] // Timing
`

{0.936006, Null}

{0.234002, Null}

-
Of course I compile it for actual use - not posted to keep post cleaner. Nonetheless, since you answered, bounty is yours, and +1 –  ciao Jul 12 '14 at 22:00