ด้วยจิตวิญญาณของxkcd นี้

เขียนโปรแกรมที่เล่นกอล์ฟ regex พร้อมกับลิสต์คู่โดยพลการ อย่างน้อยโปรแกรมควรพยายามทำให้สั้น regex โปรแกรมที่เพิ่งออก/^(item1|item2|item3|item4)$/หรือคล้ายกันไม่ได้รับอนุญาต

การให้คะแนนขึ้นอยู่กับความสามารถในการสร้าง regex ที่สั้นที่สุด รายการทดสอบเป็นของผู้สมัครชิงตำแหน่งประธานาธิบดีสหรัฐที่ประสบความสำเร็จและไม่ประสบความสำเร็จพบได้ที่นี่ (ขอบคุณ @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

สิ่งนี้ใช้โมดูล CPAN ที่เรียกใช้Regexp::Assembleเพื่อปรับการแสดงผลปกติให้เหมาะสม เพราะอะไรคือภาษาที่ดีกว่าสำหรับการแสดงออกปกติแล้ว 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)$

นอกจากนี้เป็นโบนัสฉันเขียน regex สำหรับทุกคำในคำถาม

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

ไม่ใช่วิธีแก้ปัญหาของฉัน (เห็นได้ชัดว่าฉันไม่ใช่ peter norvig!) แต่นี่เป็นวิธีแก้ปัญหาของคำถามที่ได้รับความอนุเคราะห์จากเขา: 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 โดยมีการปรับปรุงสองอย่าง:

1. สร้างชิ้นส่วนเพื่อใช้กับชุดอักขระ (เช่นใช้ [ab] z, [ac] z และ [bc] z หากชิ้นส่วนที่ถูกต้องคือ az, bz และ cz)
2. อนุญาตให้สร้าง "เส้นทางที่เหมาะสมที่สุด" ของหน้าปกและไม่ใช่แค่รูปหน้าปกที่ทำจากตัวเลือกที่ดีที่สุดในการทำซ้ำแต่ละครั้ง

(และยังโยนในการสุ่มเลือก)

สำหรับชุดของผู้ชนะ / ผู้แพ้ในคำถามนี้ฉันพบ 76 ตัวอักษร regex ใช้มัน:

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

บางรายละเอียดเพิ่มเติมในของฉันโพสต์บล็อกเกี่ยวกับการย้ายไปแก้ CoffeeScript