[oak perl] Words with 4 consonants in a row

[Belden Lyman]

On Thu, 2004-07-15 at 23:05, George Woolley wrote:
> B[e]ld[e]n,
> H[e]lp! S[o]m[e]n[e] t[oo]k [a]ll m[y] v[o]w[e]ls!
> St[i]ll, G[eo]rg[e] h[a]s q[ue]st[io]ns.
> 
> Wh[a]ts schws w[i]th v[o]w[e]ls?

'eschews' :)

> Wh[a]ts l[e]ngthsm[a]n m[ea]n?

I'd assumed it was a job similar to a longshoreman. It's actually
a job that involves looking after "lengths" of something: in some
places, looking after stretches of roads http://tinyurl.com/6s2k8
and in other places stretches of railway http://tinyurl.com/6s2k8

> [A]R[e] th[e]r[e] r[ea]ll[y] l[o]ts [o]f ph w[o]rds?
> D[i]d B[e]ld[e]n [u]s[e] P[e]rl f[o]r th[i]s?

For that yes but unfortunately n[o]t f[o]r th[i]s.

>  H[o]w?
> 

Here 'tis. Play with this and http://scowl.sourceforge.net to
answer the ph question :)

Belden

    #!/usr/bin/perl -s
    
    # substr-freq - find frequency of substrings in words
    # usage: substr-freq -min=4 -max=8 /path/to/dictionary
    # Belden <blyman at iii.com>
    
    use strict;
    use warnings;
    
    our( $min, $max );
    $min ||= 2;
    $max ||= 4;
    
    $min < $max
        or die "min ($min) must be smaller than max ($max)\n";
    
    my %dict;
    
    while ( my $word = <> ) {
      chomp $word;
    
      $word =~ y/A-Z/a-z/;
      $word =~ s/[^\w]//g;
    
      window( $word, \%dict, $min, $max );
    }
    
    $|++;
    
    while( my ( $seq, $num ) = each %dict ) {
      print "$num $seq\n"
    }
    
    
    no warnings 'uninitialized';
    sub window {
      my ( $word, $hr, $min, $max ) = @_;
      return if $min > $max;
    
      while( $word =~ /\G(.{$max})/ ) {
        $hr->{$1}++;
        pos($word) = pos($word) + 1;
      }
    
      --$max;
      window( $word, $hr, $min, $max ) if $max > 0;
    }