6 ms·

> I solve and write a lot of puzzlehunts, and I wanted a better programming language to use to search word lists for words satisfying unusual constraints, such

• jstanley 3y ago
  grep { len($_) == 10 && /^[^a]*a[^a]*$/i && /^[^b]*b[^b]*$/i && /^[^c]*c[^c]*$/i && /k.$/i } @words; Is there a simpler way?
  • darrenf 3y ago
    Perl has `length`, not `len` :) Also I can't resist a bit of TIMTOWTDI: my @found = grep { local $_ = lc; length == 10 && substr($_,8,1) eq "k" && join("",sort [/([abc])/g]->@*) eq "abc" } @words;
  • sltkr 3y ago
    Might as well do it on the command line at that point: $ grep '^........k.$' /usr/share/dict/words | grep a | grep b | grep c | grep -v 'a.*a' | grep -v 'b.*b' | grep -v 'c.*c' backstroke bailiwicks benchmarks branchlike bushwhacks greenbacks matchbooks piggybacks roadblocks scrapbooks slingbacks throwbacks thumbtacks
  • cmdlineluser 3y ago
    Not sure if it would be considered simpler but lookaheads can be used to express it in a single pattern. ^(?=.{8}k.$)(?=[^a]*a[^a]*$)(?=[^b]*b[^b]*$)(?=[^c]*c[^c]*$)
    • sltkr 3y ago
      It does lead to a very concise invocation: $ perl -ne 'print if /^(?=.{8}k.$)(?=[^a]*a[^a]*$)(?=[^b]*b[^b]*$)(?=[^c]*c[^c]*$)/' /usr/share/dict/words
      • shabble 3y ago
        and to squash a little further: perl -ne '/^(?=([abc].*){3})(?!.*([abc]).*\2).{8}k.$/&&print' /usr/share/dict/words
        • oneshtein 3y ago
          Bug: 11 words are missing. [me@fedora ~]$ time perl -ne '/^(?=([abc].*){3})(?!.*([abc]).*\2).{8}k.$/&&print' /usr/share/dict/words | wc -l 6 real 0m0,118s user 0m0,112s sys 0m0,007s
      • oneshtein 3y ago
        [me@fedora ~]$ time perl -ne 'print if /^(?=.{8}k.$)(?=[^a]*a[^a]*$)(?=[^b]*b[^b]*$)(?=[^c]*c[^c]*$)/' /usr/share/dict/words | wc -l 17 real 0m0,250s user 0m0,245s sys 0m0,006s
  • oneshtein 3y ago
    [me@fedora ~]$ time perl -n -e 'length($_) == 10 && /^[^a]*a[^a]*$/i && /^[^b]*b[^b]*$/i && /^[^c]*c[^c]*$/i && /k.$/i && print' /usr/share/dict/words | wc -l 26 real 0m0,168s user 0m0,162s sys 0m0,007s [me@fedora ~]$ time perl -n -e '/^(?=.{8}k.$)(?=[^a]*a[^a]*$)(?=[^b]*b[^b]*$)(?=[^c]*c[^c]*$)/ && print' /usr/share/dict/words | wc -l 17 real 0m0,260s user 0m0,254s sys 0m0,006s [me@fedora ~]$ time perl -n -e '/^.{8}k.$/ && /a/ && /b/ && /c/ && !/a.*a/ && !/b.*b/ && !/c.*c/ && print' /usr/share/dict/words | wc -l 17 real 0m0,115s user 0m0,109s sys 0m0,008s [me@fedora ~]$ time bash -c "grep '^........k.\$' /usr/share/dict/words | grep a | grep b | grep c | grep -v 'a.*a' | grep -v 'b.*b' | grep -v 'c.*c'" | wc -l 17 real 0m0,015s user 0m0,010s sys 0m0,020s [me@fedora ~]$ time awk '/^.{8}k.$/ && /a/ && /b/ && /c/ && !/a.*a/ && !/b.*b/ && ! /c.\*c/ { print }' /usr/share/dict/words | wc -l 17 real 0m0,129s user 0m0,124s sys 0m0,006s [me@fedora ~]$ time perl -n -e 'local $_ = lc; length == 11 && substr($_,8,1) eq "k" && join("",sort [/([abc])/g]->@*) eq "abc" && print' /usr/share/dict/words | wc -l 17 real 0m0,234s user 0m0,228s sys 0m0,007s
    • sltkr 3y ago
      You can also do: sed -e '/^........k.$/!d; /a/!d; /b/!d; /c/!d; /a.*a/d; /b.*b/d; /c.*c/d' /usr/share/dict/words I wouldn't expect it to be much faster than AWK, but not much slower either. Interesting that the pipeline is the fastest! I would expect the sheer number of separate processes to slow things down considerably, but apparently it doesn't really matter. Probably because the first `grep` already filters out most of the dictionary, so there isn't a lot of I/O through the pipes.
      • cptnapalm 3y ago
        The pipeline wasn't just the fastest; it left everything else in the proverbial dust!
      • oneshtein 3y ago
        [me@fedora ~]$ time sed -e '/^........k.$/!d; /a/!d; /b/!d; /c/!d; /a.*a/d; /b.*b/d; /c.*c/d' /usr/share/dict/words | wc -l 17 real 0m0,075s user 0m0,070s sys 0m0,006s
• Avshalom 3y ago
  W in Wordlist, length(W,10), maplist(\L^memberchk(L,W),[a,b,c]), nth(10,W,k).
  • jodrellblank 3y ago
    I think memberchk will do one check for each letter (not checking the rest of the list and leaving no choice point) rather than checking each letter is present only once.
    • Avshalom 3y ago
      Oh, yeah, my brain skipped over that part of the constraint. Does ruin the simplicity a bit. (findall(C,member(L,W),S),length(S,1))
• jodrellblank 3y ago
  words←⊃⎕nget 'wordlist.txt' 1 ⍝ read lines tenK←'^........k.$' ⎕S '&' ⊢ words ⍝ regex filter ↑tenK/⍨{∧/1='abc'(+/∘.∊)⍵}¨tenK ⍝ count abc and filter Dyalog APL, but it's still kinda ... heavy.
  • bear8642 3y ago
    > tenK←'^........k.$' ⎕S '&' ⊢ words ⍝ regex filter Is tenK←{(10=≢⍵)∧⍵[9]='k'}¨words better? Feel that better matches the problem spec, although requires the each
    • jodrellblank 3y ago
      ⍵[9] INDEX ERRORs on the shorter words, and that code needs a compress to do the filtering. It's a more traditional and faster approach, which is better from those viewpoints. If faster and avoiding each and using array concepts is desirable, how about: words←↑⊃⎕nget 'wordlist.txt' 1 tenK←words⌿⍨('k'=words[;9])∧(' '≠words[;10])∧(' '=words[;11]) tenK⌿⍨{∧/1='abc'(+/∘.∊)⍵}⍤1⊢tenK Mix ↑ turns the nested wordlist into a 2D array by padding short strings out to the length of the longest using spaces, which I don't like but am (ab)using here to tell when the words end.
• jodrellblank 3y ago
  sls '^........k.$' .\wordlist.txt -raw |where { $W=$_; ('a','b','c' |where { $W.Contains($_) -and $W.IndexOf($_) -eq $W.LastIndexOf($_) } ).Count -eq 3 }