TPJ One-Liner #40A name game.s<^([bcdfghjklmnpqrstvwxyz]*)(\w+).*> <$1$2 $1$2 $1o $1$2 / Bonana-Fanna-Fo-F$2 / Fe Fi Mo M$2 / $1$2!>i; Courtesy Sean M. Burke |
TPJ One-Liner #41Extracting balanced parentheses from a string |
use strict ;sub pars {my( $l,$r )=map{ "\Q$_" }split// ,shift; my(@s,@r ,$i,$o, $v);for( split/([ $l$r])/, shift){ /$l/and $s[++$o]= ++$i;for $v(1..$o)# {$r[$v].= $_ if$s[$v] >0}/$r/and $s[(grep## $s[$_]== $i,0..$#s) [0]]=-$i ,--$i<0&& last;}($i= shift)? wantarray ?@r[grep -$s[$_ ]==$i,0.. $#s]:$r [$i]: splice@r, 1;}$, ="\n" ;print pars (@ ARGV )# pars('()', "(123 (456) (789) 0)")
gives you the parenthesized substrings in order of appearance:
(123 (456) (789) 0),(456),(789)
pars('()', "(123 (456) (789) 0)", 2)
in a list context gives you list of substrings, opened on level 2:
(456),(789)
in scalar context gives you the second substring:
(456)
Courtesy Paul Clinger
TPJ One-Liner #42Extract unique elements from a list given a key function |
sub unique (&@) { my($c,%hash) = shift; grep { not $hash{&$c}++ } @_ } @list = unique { $_ } @list; # Remove duplicate strings from @list. @obj = unique { $_->name } @obj; # Only include one object for # for each name.
Courtesy Don Schwarz
TPJ One-Liner #43Seven "Magic Cards." Have a friend think of a number from 1 to 100. Give them cards one at a time and ask if their number is on the card. Mentally sum the first digits of each card with a "yes" answer. Go into trance, say the magic word "Ultrix!" and announce their number. Known to win bar bets. |
for $a(0..6){$b=1;for $c(1..100){if($c&2**$a){printf "%3d ",$c;print"\n"if!($b++%10)}}print"\n\n\n"}
Courtesy Bill Huston