jpl has asked for the wisdom of the Perl Monks concerning the following question:
I'm rebuilding a house, thereby insuring that I will honor my vows of poverty. We have a "plantcam" set up, taking a picture every 30 seconds, so I can make animated movies of my money disappearing. Individual pictures have names of the form
WSPC2420.JPG
with the final four digits ranging from 0001 through 9999 (if the battery and SD card last that long). There are long sequences of pictures where nothing of interest happens, punctuated by sequences worth animating. So I make notes like
427-2301 chimney goes up
2622-2630 chimney falls down
I want to turn these numerical ranges into glob patterns so that (just) the right pictures are passed to the animation command. The second range, for example, would turn into
I started out constructing the globs by hand, but that loses its charm quickly, and is prone to error. So I figured it should be a simple perl script. I have a working script (below), but I am disappointed at how baroque it is. It seems that with so much structure to both ranges and globs, a beautiful solution should exist.262[2-9] 2630
I am aware, by the way, that what the animation command sees as arguments is the expanded list of individual file names, so I'm not saving it any work by having the shell expand a glob versus simply itemizing the names (which would be trivial, but intensely ugly for long sequences). And, besides, it should be an interesting problem upon which to meditate.
#!/usr/bin/perl -w use strict; sub r2g { my $lower = shift; my $upper = shift; my $maxlen = length($upper); $maxlen = length($lower) if ( length($lower) > $maxlen ); my @globs; my $format = "%0${maxlen}d"; my $maxn = $lower; # Take care of two fringe cases return [ sprintf( $format, $maxn ) ] if ( $maxn == $upper ); return [ '?' x $maxlen ] if ( ( $maxn == 0 ) && ( $upper == '9' x $maxlen ) ); PATTERN: # $maxn is the least number in the range $lower through $upper # that isn't already matched by some glob pattern. # We can only put a (non-trivial) glob pattern in a position # if all the positions to the right are already globbed with '?'. # The largest number matched by such a glob ends with 1 or more 9' +s. while ( $maxn <= $upper ) { for ( my $i = $maxlen - 1 ; $i >= 0 ; --$i ) { my $pattern = $maxn = sprintf( $format, $maxn ); for ( my $j = $i + 1 ; $j < $maxlen ; ++$j ) { substr( $pattern, $j, 1 ) = '?'; } my $c = substr( $maxn, $i, 1 ); if ( $c ne '0' ) { # We cannot glob further left # See if we can glob starting here foreach my $d ( reverse( $c .. '9' ) ) { substr( $maxn, $i, 1 ) = $d; if ( $maxn <= $upper ) { substr( $pattern, $i, 1 ) = ( $d eq $c ) ? $d : "[$c-$d]"; substr( $maxn, $i, 1 ) = $d; push( @globs, $pattern ); ++$maxn; next PATTERN; } } } else { # We can glob with a ? here if replacing the digit # with a 9 still remains less than or equal to $upper foreach my $d ( reverse( '0' .. '9' ) ) { substr( $maxn, $i, 1 ) = $d; if ( $maxn <= $upper ) { if ( $d ne '9' ) { # Couldn't do a ? match. # Glob what we can, increment $maxn # and look for a new pattern substr( $pattern, $i, 1 ) = ( $d eq '0' ) ? '0' : "[0-$d]"; push( @globs, $pattern ); ++$maxn; next PATTERN; } last PATTERN if ( $i == 0 ); last; } } } } } return \@globs; } # my $g = r2g("0123", "1243"); # print("@$g\n"); # $g = r2g("0000", "1243"); # print("@$g\n"); # $g = r2g("0001", "9999"); # print("@$g\n"); # $g = r2g("0000", "9999"); # print("@$g\n"); # $g = r2g("0000", "0999"); # print("@$g\n"); # $g = r2g("9000", "9999"); # print("@$g\n"); while ( my $line = <> ) { if ( $line =~ /([0-9]+)[^0-9]+([0-9]+)/ ) { my $g = r2g( $1, $2 ); print("$1-$2: @$g\n"); } }
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: ranges to globs - OT
by ww (Archbishop) on May 14, 2011 at 21:19 UTC | |
by jpl (Monk) on May 14, 2011 at 22:21 UTC | |
Re: ranges to globs
by Anonymous Monk on May 14, 2011 at 19:04 UTC | |
by jpl (Monk) on May 14, 2011 at 19:59 UTC | |
Re: ranges to globs
by repellent (Priest) on May 20, 2011 at 20:11 UTC |