このxkcdの精神で

リストの任意のペアで正規表現ゴルフをプレイするプログラムを作成します。プログラムは、少なくとも正規表現を短くしようとする必要/^(item1|item2|item3|item4)$/があります。出力などのプログラムは許可されません。

スコアリングは、最短の正規表現を生成する機能に基づいています。テストリストは、ここにある米国大統領候補の成功例と失敗例です（@Peterに感謝）。もちろん、このプログラムはすべてのばらばらのリストに対して機能する必要があるため、単純に社長に答えを返すことは重要ではありません。

Perl（111 110 122文字）

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

これはRegexp::Assemble、正規表現を最適化するために呼び出されるCPANモジュールを使用します。正規表現に適した言語はPerlよりも優れているからです。

また、読みやすいバージョン、ただの楽しみのために（の助けを借りて作られた-MO=Deparse）。

use Regexp::Assemble;
my $r = Regexp::Assemble->new;
while (<>) {
    chomp($_);
    $r->add("^\Q$_\E\$");
}
$_ = $r->as_string;
# Replace wasteful (?:, even if it's technically correct.
s/\(\?:/(/g;
print $_;

サンプル出力（の後にCTRL-Dを実行しましたitem4）。

$ perl assemble.pl
item1
atem2
item3
item4
^(item[134]|atem2)$

また、ボーナスとして、質問のすべての単語の正規表現を書いています。

^(a((ttemp)?t|llowed\.|rbitrary)?|\/\^item1\|atem2\|item3\|item4\$\/|s(ho(rt,|uld)|imilar)|p((air|lay)s|rogram)|(Writ|mak|Th)e|l(ists\.|east)|o([fr]|utputs)|t(h(at|e)|o)|(jus|no)t|regex|golf|with|is)$

また、大統領のリスト（262バイト）。

^(((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)$

ではない私の解決策（明らかに私はピーター・ノーヴィグないよ！）が、ここでは彼の（わずかに変更された）質問の礼儀のソリューションです： http://nbviewer.ipython.org/url/norvig.com/ipython/xkcd1313.ipynbは、

彼が提供するプログラムは次のとおりです（私の仕事ではなく、彼の仕事です）：

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))
        cover.append(best)
        pool.remove(best)
        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 {''}  
    else:
        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)
answer
# 'a.a|i..n|j|li|a.t|a..i|bu|oo|n.e|ay.|tr|rc|po|ls|oe|e.a'

勝者と敗者はそれぞれ勝者リストと敗者リスト（またはもちろん2つのリスト）であり、詳細な説明については記事を参照してください。

Factorで書かれた私のソリューション：

USING:
    formatting fry
    grouping
    kernel
    math math.combinatorics math.ranges
    pcre
    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)

Norvigと同じアルゴリズムです。読みやすさを損なうことが目標であれば、おそらくもっと多くのキャラクターをゴルフで追い払うことができます。

私のコードはあまりゴルフっぽく凝縮されたものではありませんが、https：//github.com/amitayd/regexp-golf-coffeescript/（または具体的にはsrc / regexpGolf.coffeeのアルゴリズム）で確認できます。

Peter Norvigのアルゴリズムに基づいており、次の2つの改善点があります。

1. 文字セットで使用するパーツを作成します（有効なパーツがaz、bz、czの場合は[ab] z、[ac] z、[bc] zを使用します）。
2. 各反復で最適な候補からなるカバーだけでなく、カバーの「最適な最適パス」を構築することができます。

（また、オプションのランダム性を投入しました）

このクイズの勝者/敗者のセットについて、76文字の正規表現を使用しました。

[Jisn]e..|[dcih]..o|[AaG].a|[sro].i|T[ar]|[PHx]o|V|[oy]e|lev|sh$|u.e|rte|nle

私の中のいくつかの詳細のCoffeeScriptにソルバーを移植に関するブログ記事。