In the spirit of this xkcd

enter link description here

Write a program that plays regex golf with arbitrary pairs of lists. The program should at least attempt to make the regex short, a program that just outputs /^(item1|item2|item3|item4)$/ or similar is not allowed.

Scoring is based on the ability to generate the shortest regex. The test lists are those of successful and unsuccessful US presidential candidates, found here (thanks @Peter). Of course, the program must work for all disjoint lists, so simply returning an answer for the president one doesn't count.

  • 3
    \$\begingroup\$ /^item1|atem2|item3|item4$/ probably has unintended precedence (string has to either begin with item1, contain atem2, contain item3, or end with item4). \$\endgroup\$
    – null
    Commented Jan 6, 2014 at 8:43
  • 7
    \$\begingroup\$ This would be a more interesting challenge if it had a scoring system based primarily on the size of the regexes generated. \$\endgroup\$ Commented Jan 6, 2014 at 10:33
  • 2
    \$\begingroup\$ In the spirit of the XKCD title text, successful and unsuccessful US presidential candidates. (NB I made this list by hand following Wikipedia, so there might be small errors; I've removed from the list of losers all surnames matching a winner, because otherwise distinguishing the lists is impossible, but I've deliberately not otherwise deduplicated). \$\endgroup\$ Commented Jan 6, 2014 at 11:15
  • 5
    \$\begingroup\$ I wonder if Randall Munroe is a better writer of code-golf challenges than we are... \$\endgroup\$ Commented Jan 6, 2014 at 12:36
  • 7
    \$\begingroup\$ I wonder if Randall Munroe is gonna throw down on this question. \$\endgroup\$
    – boothby
    Commented Jan 7, 2014 at 8:00

4 Answers 4


Perl (111 110 122 characters)

use Regexp::Assemble;@ARGV=shift;my$r=new Regexp::Assemble;chomp,add$r "^\Q$_\E\$"while<>;$_=as_string$r;s/\(\?:/(/g;print

This uses CPAN module called Regexp::Assemble in order to optimize the regular expressions. Because what is the better language for regular expressions then Perl.

Also, readable version, just for fun (made with help of -MO=Deparse).

use Regexp::Assemble;
my $r = Regexp::Assemble->new;
while (<>) {
$_ = $r->as_string;
# Replace wasteful (?:, even if it's technically correct.
print $_;

Sample output (I did CTRL-D after item4).

$ perl assemble.pl

Also, as a bonus, I'm writing the regex for every word in the question.


Also, list of presidents (262 bytes).

^(((J(effer|ack|ohn)s|W(ashingt|ils)|Nix)o|Van Bure|Lincol)n|C(l(eveland|inton)|oolidge|arter)|H(a(r(rison|ding)|yes)|oover)|M(cKinley|adison|onroe)|T(a(ylor|ft)|ruman)|R(oosevelt|eagan)|G(arfield|rant)|Bu(chanan|sh)|P(ierce|olk)|Eisenhower|Kennedy|Adams|Obama)$
  • \$\begingroup\$ This appears to read stdin for one list and force the other to be empty. Surely that's not what the question is asking for? \$\endgroup\$ Commented Jan 6, 2014 at 10:23
  • 1
    \$\begingroup\$ @PeterTaylor: Well, it's not that the second list is of any importance. Unless second list has duplicates of first list, the regexp is valid. It would be nice to have a shorter regexp, but I'm sort of lazy. \$\endgroup\$
    – null
    Commented Jan 6, 2014 at 10:26
  • \$\begingroup\$ IMO you should at least have a way to take it as input, even if you then discard it. \$\endgroup\$ Commented Jan 6, 2014 at 10:32
  • \$\begingroup\$ @PeterTaylor: If you say so. My program now takes two arguments, one of them being the first list. \$\endgroup\$
    – null
    Commented Jan 6, 2014 at 10:34
  • 4
    \$\begingroup\$ This is cool; but it produces needlessly long expressions since it creates exclusion (for any other list) by matching every possible full word. Which is not quite the same spirit as the original golf. \$\endgroup\$
    – Nicole
    Commented Jan 7, 2014 at 4:57

Not my solution (obviously I'm not peter norvig!) but here's a solution of the (slightly modified) question courtesy of him: http://nbviewer.ipython.org/url/norvig.com/ipython/xkcd1313.ipynb

the program he gives is as follows (his work, not mine):

def findregex(winners, losers):
    "Find a regex that matches all winners but no losers (sets of strings)."
    # Make a pool of candidate components, then pick from them to cover winners.
    # On each iteration, add the best component to 'cover'; finally disjoin them together.
    pool = candidate_components(winners, losers)
    cover = []
    while winners:
        best = max(pool, key=lambda c: 3*len(matches(c, winners)) - len(c))
        winners = winners - matches(best, winners)
    return '|'.join(cover)

def candidate_components(winners, losers):
    "Return components, c, that match at least one winner, w, but no loser."
    parts = set(mappend(dotify, mappend(subparts, winners)))
    wholes = {'^'+winner+'$' for winner in winners}
    return wholes | {p for p in parts if not matches(p, losers)}

def mappend(function, *sequences):
    """Map the function over the arguments.  Each result should be a sequence. 
    Append all the results together into one big list."""
    results = map(function, *sequences)
    return [item for result in results for item in result]

def subparts(word):
    "Return a set of subparts of word, consecutive characters up to length 4, plus the whole word."
    return set(word[i:i+n] for i in range(len(word)) for n in (1, 2, 3, 4)) 

def dotify(part):
    "Return all ways to replace a subset of chars in part with '.'."
    if part == '':
        return {''}  
        return {c+rest for rest in dotify(part[1:]) for c in ('.', part[0]) }

def matches(regex, strings):
    "Return a set of all the strings that are matched by regex."
    return {s for s in strings if re.search(regex, s)}

answer = findregex(winners, losers)
# 'a.a|i..n|j|li|a.t|a..i|bu|oo|n.e|ay.|tr|rc|po|ls|oe|e.a'

where winners and losers are the winners and losers lists respectively (or any 2 lists of course) see the article for detailed explanations.

  • 8
    \$\begingroup\$ While the linked article is interesting and I enjoyed reading it, this would have been better posted as a comment on the question instead of as an answer since it doesn't answer the posed question. \$\endgroup\$
    – Gareth
    Commented Jan 7, 2014 at 11:04
  • 1
    \$\begingroup\$ You're right, it might have been better as a comment, I posted it as an answer simply because it answers the question perfectly. I didn't copy out the solution as I thought that'd be disingenuous and trying to take credit for someone elses work, in addition to providing a program that plays regex golf with 2 pairs of lists it also gives a fitness function and detailed code explanation along with the parallel to the set cover problem which I hadn't considered. If you still think it's not relevant, let me know, I'll delete and post as a comment. \$\endgroup\$
    – Mike H-R
    Commented Jan 7, 2014 at 20:54
  • 1
    \$\begingroup\$ If you're worried about taking credit for someone else's work, flag and ask for a mod to make your answer "Community wiki". \$\endgroup\$ Commented Jan 8, 2014 at 8:44
  • 1
    \$\begingroup\$ @PeterTaylor cool, I didn't know that was the protocol, done. \$\endgroup\$
    – Mike H-R
    Commented Jan 8, 2014 at 11:24

My solution written in Factor:

    formatting fry
    math math.combinatorics math.ranges
    sequences sets ;
IN: xkcd1313

: name-set ( str -- set )
    "\\s" split members ;

: winners ( -- set )
    "washington adams jefferson jefferson madison madison monroe
monroe adams jackson jackson vanburen harrison polk taylor pierce buchanan
lincoln lincoln grant grant hayes garfield cleveland harrison cleveland     mckinley
 mckinley roosevelt taft wilson wilson harding coolidge hoover roosevelt
roosevelt roosevelt roosevelt truman eisenhower eisenhower kennedy johnson     nixon
nixon carter reagan reagan bush clinton clinton bush bush obama obama" name-set ;

: losers ( -- set )
    "clinton jefferson adams pinckney pinckney clinton king adams
jackson adams clay vanburen vanburen clay cass scott fremont breckinridge
mcclellan seymour greeley tilden hancock blaine cleveland harrison bryan bryan
parker bryan roosevelt hughes cox davis smith hoover landon wilkie dewey dewey
stevenson stevenson nixon goldwater humphrey mcgovern ford carter mondale
dukakis bush dole gore kerry mccain romney" name-set winners diff
    { "fremont" } diff "fillmore" suffix ;

: matches ( seq regex -- seq' )
    '[ _ findall empty? not ] filter ;

: mconcat ( seq quot -- set )
    map concat members ; inline

: dotify ( str -- seq )
    { t f } over length selections [ [ CHAR: . rot ? ] "" 2map-as ] with map ;

: subparts ( str -- seq )
    1 4 [a,b] [ clump ] with mconcat ;

: candidate-components ( winners losers -- seq )
        [ [ "^%s$" sprintf ] map ]
        [ [ subparts ] mconcat [ dotify ] mconcat ] bi append
    ] dip swap [ matches empty? ] with filter ;

: find-cover ( winners candidates -- cover )
    swap [ drop { } ] [
        2dup '[ _ over matches length 3 * swap length - ] supremum-by [
            [ dupd matches diff ] [ rot remove ] bi find-cover
        ] keep prefix
    ] if-empty ;

: find-regex ( winners losers -- regex )
    dupd candidate-components find-cover "|" join ;

: verify ( winners losers regex -- ? )
    swap over [
        dupd matches diff "Error: should match but did not: %s\n"
    ] [
        matches "Error: should not match but did: %s\n"
    ] 2bi* [
        dupd '[ ", " join _ printf ] unless-empty empty?
    ] 2bi@ and ;

: print-stats ( legend winners regex -- )
    dup length rot "|" join length over /
    "separating %s: '%s' (%d chars %.1f ratio)\n" printf ;

: (find-both) ( winners losers legend -- )
    -rot 2dup find-regex [ verify t assert= ] 3keep nip print-stats ;

: find-both ( winners losers -- )
    [ "1 from 2" (find-both) ] [ swap "2 from 1" (find-both) ] 2bi ;

IN: scratchpad winners losers find-both 
separating 1 from 2: 'a.a|a..i|j|li|a.t|i..n|bu|oo|ay.|n.e|ma|oe|po|rc|ls|l.v' (55 chars 4.8 ratio)
separating 2 from 1: 'go|e..y|br|cc|hu|do|k.e|.mo|o.d|s..t|ss|ti|oc|bl|pa|ox|av|st|du|om|cla|k..g' (75 chars 3.3 ratio)

It's the same algorithm as Norvig's. If hurting readability is the goal then you can probably golf away many more characters.

  • 1
    \$\begingroup\$ FYI, you are missing a bunch of the losers from the official list (Burr, Jay, Badnarik, probably others I'm not seeing). So, your results are incorrect; for example, the first regex doesn't work, because it matches Burr and Jay. \$\endgroup\$
    – elixenide
    Commented Jan 9, 2014 at 20:56

My code is not in a very golf-ish and condensed fashion, but you can check it at https://github.com/amitayd/regexp-golf-coffeescript/ (or specifically the algorithm at src/regexpGolf.coffee).

It's based on Peter Norvig's algorithm, with two improvements:

  1. Create parts to use with character sets (i.e. use [ab]z, [ac]z, and [bc]z if valid parts are az, bz and cz).
  2. Allow to construct "top optimal paths" of covers, and not just a cover made of the best candidate at each iteration.

(And also threw in an optional randomness)

For the sets of winners/losers in this quiz I found a 76 chars regex using it:


Some more details in my blog post about porting the solver to coffeescript.

  • 2
    \$\begingroup\$ Could you please contain your code in your answer? Otherwise, we can't see the code without clicking on the link! \$\endgroup\$
    – wizzwizz4
    Commented Mar 1, 2016 at 17:05

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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