75

s[\B([^\s]*)\B(?=\w)][join'',sort{.5>rand}split'',$1]ge,print while<DA
+TA>;
[download]

72

s[\B(\S*)\B(?=\w)][join'',sort{.5>rand}split'',$1]ge,print while<DATA>
+;
[download]

66

s[\B(\w+)\B][join'',sort{.5>rand}split'',$1]ge,print while<DATA>;
[download]

P:\test>junk
Down taht path leis madenss. On the ohter hnad, the road to hlel is pe
+avd with mnilteg slwalbnos.
Augltohh the Prel Sloagn is Tehre's More Than One Way to Do It, I htsi
+etae to mkae 10 wyas to do setmonihg.
And don't tlel me there isn't one bit of drecfefine between null and s
+pace, bsauece taht's etcaxly how much dreneciffe there is.
Rdnaal siad it wluod be tguoh to do in sed. He didn't say he didn't ud
+nerasntd sed. Rnaadl udnertsands sed qtuie well. Wchih is why he uess
+ Perl.
As usual, I'm oitasrvetng the case to kcnok a few nnrueos loose, but t
+he truth is ullasuy sreeomwhe in the mudlde, uh, mlddie.
Of crouse, I rseerve the right to mkae wohlly siuptd changes to Prel i
+f I tnhik they ivrompe the lgnuagae.
[download]

++ for realizing that a fair shuffle isn't necessary. You can trim a few chars by getting rid of the rand call entirely, and using non-paired delimiters, $&, and an alternative to split:

s!\B\w+\B!join'',sort{1}$&=~/./g!eg
[download]

---

Caution: Contents may have been coded under pressure.

Come to that, why bother with the comparison block at all :)

s!\B\w+\B!join'',sort$&=~/./g!eg

P:\test>junk
Down taht path leis madenss. On the oehtr hand, the raod to hell is pa
+evd with meilntg sabllnows.
Aghlotuh the Perl Saglon is Tehre's More Tahn One Way to Do It, I haei
+stte to make 10 ways to do sehimnotg.
And don't tell me tehre isn't one bit of dceeffinre beeetwn nlul and s
+acpe, bacesue taht's eacltxy how mcuh dceeffinre tehre is.
Raadnl said it wloud be tgouh to do in sed. He ddin't say he ddin't ua
+dennrstd sed. Raadnl uaddennrsts sed qitue well. Wchih is why he uess
+ Perl.
As uasul, I'm oaeinrsttvg the case to kcnok a few nenorus loose, but t
+he trtuh is uallsuy seehmorwe in the mddlue, uh, mddile.
Of corsue, I reersve the rghit to make whlloy siptud caeghns to Perl i
+f I think tehy imoprve the laaggnue.
[download]

---

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?

"Science is about questioning the status quo. Questioning authority".

In the absence of evidence, opinion is indistinguishable from prejudice.

66

s[\B(\w+)\B][join'',sort{.5>rand}split'',$1]ge,print while<DATA>;
[download]

Some common golfing micro-"optimizations":

s|\B\w+\B|join'',sort{.5>rand}$&=~/./g|ge,print for<DATA>
[download]

1. There's no reason to explicitly skip words less then 4 characters. if it's less then four, shuffling the "middle letters" will either be a shuffle of one, or zero characters.
2. This doesn't solve the problem exactly as you described (your requirements about comma,period are pretty specific, and don't cover other punctuation), but it's pretty close...

   #!perl -p
   use List::Util 'shuffle';
   $_=~s{(?<=\b\w)(\w+)(?=\w\b)}{join'',shuffle split//,$1}xeg;
   [download]

   It's by no means a good Golf ... but it's a good starting point.

perl -MList::Util=shuffle -pe '$_=~s{(?<=\b\w)(\w+)(?=\w\b)}{join"",sh
+uffle split//,$1}xeg;'
[download]

You have more rigor in your regex than is needed.

perl -MList::Util=shuffle -pe 's:\B\w+\B:join"",shuffle split//,$&:ge'
[download]

---

Caution: Contents may have been coded under pressure.

Look Ma, no modules!

perl -pe's!\B\w+\B!@s=split//,$&;my$s;$s.=splice@s,rand@s,1while@s;$s!
+eg'
[download]

Three chars for List::Util is a good trade, I think... :-)

-sauoq
"My two cents aren't worth a dime.";

ahh, \B ... I can't remember the last time i had a reason to use that ... nice catch.

The following uses pretty much the original code, but dispenses with the naughty use of a module:

while(<DATA>){@x=split;for(@x){$o=/[.,]$/?2:1;$m=substr$_,0,1,'';
$e=substr$_,-$o,$o,'';$m.=substr$_,rand(length),1,''while$_;$_="$m$e"}
print"@x\n"}
[download]

Update: remove a few more chars, and some more (Thanks Bart), and some more (ditto)

using s/// to detect the punctuation, and it can be shorter still:

while(<DATA>){for(@x=split){s/([.,]?)$//;$s=substr$_,0,1,'';
$e=chop;$s.=substr$_,rand(length),1,''while$_;$_="$s$e$1"}
print"@x\n"}
[download]

Update: took out reverse in favour of a random shuffle

while (<DATA>)
{
 $_=~s/([.,\s]*?)(\w{1})(\w+)(\w{1})([,.\s]*?)(?{$j=sub{$x=shift;for(1
+..50){$n=int(rand(length($x)-1));$x=reverse(substr($x,0,$n)).substr($
+x,$n);}return $x };$x=$j->($3)})/$1$2$x$4$5/g;
  print $_;
}
__DATA__
Down that path lies madness. On the other hand, the road to hell is pa
+ved with melting snowballs.
Although the Perl Slogan is There's More Than One Way to Do It, I hesi
+tate to make 10 ways to do something.
And don't tell me there isn't one bit of difference between null and s
+pace, because that's exactly how much difference there is.
Randal said it would be tough to do in sed. He didn't say he didn't un
+derstand sed. Randal understands sed quite well. Which is why he uses
+ Perl.
As usual, I'm overstating the case to knock a few neurons loose, but t
+he truth is usually somewhere in the muddle, uh, middle.
Of course, I reserve the right to make wholly stupid changes to Perl i
+f I think they improve the language.
[download]

Update: Slightly OT for perl, but IIRC, this phenomenon is theorised to derive from 'orthographic word recognition', recognising the entire word by it's overall shape. As long as the outline of the word is roughly the same, the brain can make a pretty good stab at recognising it. It will probably also be helped by a priming effect, whereby the words most likely to follow a given word will be more 'activated'. There's some research (somewhere that is, I'm trying to track it down) suggesting that the more different the outline is from the original (especially through the placement of rising and falling letters like p and l) the more difficult it will be to recognise.

local $";
while (<DATA>) {
    s/(\w{4,})/@l=split'',$1;@m=@l[1..$#l-1];@r=map{splice@m,rand @m,1
+}@m;"$l[0]@r$l[-1]"/ge;
    print;
}

__DATA__
Down that path lies madness. On the other hand, the road to hell is pa
+ved with melting snowballs.
Although the Perl Slogan is There's More Than One Way to Do It, I hesi
+tate to make 10 ways to do something.
And don't tell me there isn't one bit of difference between null and s
+pace, because that's exactly how much difference there is.
Randal said it would be tough to do in sed. He didn't say he didn't un
+derstand sed. Randal understands sed quite well. Which is why he uses
+ Perl.
As usual, I'm overstating the case to knock a few neurons loose, but t
+he truth is usually somewhere in the muddle, uh, middle.
Of course, I reserve the right to make wholly stupid changes to Perl i
+f I think they improve the language.
[download]

Aoccdrnig to rscheearch at Cmabrigde uinervtisy, it deosn't mttaer waht oredr the ltteers in a wrod are, the olny iprmoetnt tihng is taht the frist and lsat ltteres are at the rghit pclae. The rset can be a tatol mses and you can sitll raed it wouthit a porbelm. Tihs is bcuseae we do not raed ervey lteter by it slef but the wrod as a wlohe.

That aside, it's interesting to see why this phenomenon seems to exist. I ran the following program against my /usr/dict/words file:

#!/usr/bin/perl

use strict;
use warnings;

my %words;

while (<>) {
  chomp($_ = lc);
  for (/\b\w+(?:'\w+)?\b/g) {
    next unless length > 3;
    my $order = join "", sort split //;
    $words{substr($_, 0, 1) . substr($_, -1, 1)}{$order}{$_} = 1;
  }
}

for my $k (sort keys %words) {
  my @multi = grep keys %{ $words{$k}{$_} } > 1, keys %{ $words{$k} } 
+or next;  

  print "$k\n";
  for my $o (sort @multi) {
    my $w = $words{$k}{$o};
    print "  $o (" . keys(%$w) . ") @{[ keys %$w ]}\n";
  }
}
[download]

I ran this on my local copy of the King James bible (doesn't everyone have one of those?) and came up with only 60 pairs of words (and no triplets, quadruplets, etc.).

Actually, this has appeared on PM before:

Txet Maglning Glof, Ayobndy?

(And I submit it now to help future searchers... and because it's cool ;-) )

HTH,

Another relevant link is http://www.snopes.com/language/apocryph/cambridge.asp , which includes an example of an email that people forwarded compulsively a couple of years ago. I don't know how many times I got it...

Being almost entirely monolingual (a Bad Thing,imho) and Anglophonic, I wonder if the same thing happens in other languages written in something resembling an alphabet (e.g., not Chinese). Darren's code should work as well on data in, say, German or French.

You might find this interesting.

(Gratuitiously stolen from jZed's reply to a similar post by Uksza ;)

Cheers,
--Darren