$string =~ s/(.)/$1 x (1 + rand(3))/egs;
[download]

You might want to capture only letters instead.



my $string = "It's a cat and mouse game.";
$string =~ s/(.)/$1 x (1 + rand(3))/ges;
print "$string\n";

$string = "It's a cat and mouse game.";
$string =~ s/([A-Za-z])/$1 x (1 + rand(3))/ges;
print "$string\n";
[download]

And the output is -


IIIt'''s  a  cccat annddd mmoooussee gaammeee...
IIItt'sss aa cccaaattt and mmoouusee ggaame.
[download]

Note that in the first case, spaces are multiplied too. But I thought the original question was to multiply letters only. ;-)

Update: Crossed out my comment. I agree I was too fussy on the 'technical correctness'. What's more important is not the code, but the idea that's behind it. And yes I like tilly's code too.

What do you define a letter to be?

I found that part of the spec ambiguous and so made up a convenient definition. *shrug*

Roger, I personally think that, it is easier to get the idea across, if the demo code has a clear focus.

This is close to what you said, but made it one liner:

use strict;
use warnings;

my $str = "cat";
print join("", map {$_ x (1 + rand(3))} split //, $str);
[download]

use strict;
use warnings;

for (1..5) {
  my $string = q{It's a cat and mouse game.};

  my $i = length($string) + 1;
  CHAR: while ($i--) {
    for my $c (substr($string, $i, 1)) {
      next CHAR unless $c =~ /^[a-zA-ZäöüßÄÖÜ]$/;
      # do whatever you want here
      $c .= $c x rand(7);
    }
  }

  print $string, "\n";
}
[download]

Here's a little trick you can use in Latin1 character encoding (instead of locales) to avoid having to name all non-US word characters explicitly: just define the character set as [A-Za-zÀ-ÿ]. If you look at a Latin1 character table, you'll see what it does--and it works for more than just German. :)

--
Allolex

Good point. But I think even more dangerous that using only [a-z] (my example, too). I think this should work quite well:

      next CHAR if $c =~ /^[[:punct:][:cntrl:][:blank:]]$/;
[download]

Add [:digit:] to exclude numbers, too.

---

_Search, Ask, ^Know

{
    my $r = substr rand, 2;
    sub crand() {
        length $r or $r = substr rand, 2;
        chop $r;
    }
}

s[(.)]{$1 x (1+crand/3)}ge;
[download]

It looks cute, but it's wrong. About once every 10,000 times, rand() returns a number that's smaller than 0.0001, and that gets represented in scientific notation, meaning there are an 'e' and a '-' in the string.

#!/usr/bin/perl

use strict;
use warnings;

my $c = 0;

while (1) {
    $c ++;
    my $r = rand;
    die "Failed ($r) after $c attempts.\n" if substr ($r, 2) =~ /\D/;
}
 
__END__
Failed (1.13079331747201195e-05) after 17507 attempts.
[download]

Abigail

Thanks for the pointer. Simple fix:

{
    my $r = substr rand, 2;
    sub crand() {
        length $r or ($r = rand) =~ tr/0-9//cd;
        chop $r;
    }
}

s[(.)]{$1 x (1+crand/3)}ge;
[download]

On that note one could also

# ...
        length $r or ($r = rand) =~ tr/3-9//cd;
# ...

s[(.)]{$1 x crand/3}ge;
[download]

and even move the division up into crand although that's not a generic "cached rand" anymore.

Makeshifts last the longest.

I haven't seen a completely substr() solution yet, so here's one:

#!/usr/bin/perl
my $str = "cat"; 
for (reverse 0..(length($str)-1)) { substr($str,$_,1) x= rand(9)+1; }
print "$str\n";
[download]

Random stuff that occurs to me:

• I think this is the first time I've ever used the x= operator
• I assumed (as everyone else) that you want at least 1 of each letter (i.e., that you don't want to delete letters)
• I hope it's clear why the reverse is necessary

What can be done with foreach can usually be done on fewer lines with map...

$;=sub{$/};@;=map{my($a,$b)=($_,$;);$;=sub{$a.$b->()}}
split//,".rekcah lreP rehtona tsuJ";$\=$ ;->();print$/
[download]

But you can not omit the (1 + rand ...) bit. Otherwise you will be dropping characters when the $_ x rand 8 bit evaluates to $_ x 0.



my $string = "It's a cat and mouse game.";
$string=join'',map{$_ x rand 3}split//,$string;
print "$string\n";

$string = "It's a cat and mouse game.";
$string=join'',map{$_ x (1 + rand 3)}split//,$string;
print "$string\n";
[download]

And the output -


It'ss a caatt  aannoouuss  gaae
It'''sss aa  cccaaattt   and mmmoussseee gggaaammee...
[download]

Heh. I took things too literally, as is my tendency on occasion. I read "random number of letters" and assumed without further thought that zero is a perfectly cromulent random number. If you want a nonzero random number, then replace rand 8 with (1+rand 7). Vary the number 7 according to taste.

---

$;=sub{$/};@;=map{my($a,$b)=($_,$;);$;=sub{$a.$b->()}}
split//,".rekcah lreP rehtona tsuJ";$\=$ ;->();print$/
[download]