Beefy Boxes and Bandwidth Generously Provided by pair Networks httptech
laziness, impatience, and hubris
 
PerlMonks  

Txet Maglning Glof, Ayobndy?

by Cody Pendant (Prior)
on Sep 16, 2003 at 04:31 UTC ( #291720=perlquestion: print w/ replies, xml ) Need Help??
Cody Pendant has asked for the wisdom of the Perl Monks concerning the following question:

I'm guessing most of you have seen this much-forwarded email?
Aoccdrnig to a rscheearch at an Elingsh uinervtisy, it deosn't mttaer in waht oredr the ltteers in a wrod are, the olny iprmoetnt tihng is that frist and lsat ltteer is at the rghit pclae. The rset can be a toatl mses and you can sitll raed it wouthit porbelm. Tihs is bcuseae we do not raed ervey lteter by it slef but the wrod as a wlohe.

It's an interesting phenomenon, but who wants to play golf with the process to put regular text into this strange form of mangled but still readable text?

The first and last letters must be correct, and the rest of the letters must be out of order.

Here's a version I'm totally not proud of but I put it together in a few minutes.

sub mangle { my $input = shift (); my @words = split ('\s', $input); foreach my $item (@words) { my $punctuation = ''; if($item =~ s/(\.|,)$//){ $punctuation = $1; } if (length($item) > 3) { $item =~ m/^(.)(.+?)(.)$/; my $centre = $2; while ($centre eq $2) { my @centre = split ('', $2); shuffle(@centre); $centre = join ('', @centre); } $item = $1 . $centre . $3 . $punctuation; } else { $item .= $punctuation; } } return join (' ', @words); } ### NB: shuffle routine is not my work. sub shuffle { my $i = @_; # length of @_ array while ($i) { my $j = rand $i--; @_[ $i, $j ] = @_[ $j, $i ]; # 0 <= int($j) <= $i } }


($_='kkvvttuubbooppuuiiffssqqffssmmiibbddllffss') =~y~b-v~a-z~s; print

Comment on Txet Maglning Glof, Ayobndy?
Select or Download Code
Re: Txet Maglning Glof, Ayobndy?
by Cody Pendant (Prior) on Sep 16, 2003 at 05:13 UTC
    Update -- just realised that the code above goes into an infinite loop for words like, ironically, "loop" where the central part of the word is "unmangleable". Exercise for the reader.

    Update -- Some very neat and very small solutions below, but just to restate, the code should mangle every word over three letters, but return them with the first and last letters in place. Except where the word is in the set of unmangleable words, which are four-letter words with double letters in the middle.



    ($_='kkvvttuubbooppuuiiffssqqffssmmiibbddllffss') =~y~b-v~a-z~s; print
Re: Txet Maglning Glof, Ayobndy?
by jmcnamara (Monsignor) on Sep 16, 2003 at 05:50 UTC

    perl -pe 's/(\w)(\w+)(\w)/split"",$2;$,="";$,.=splice@_,rand@_,1while@ +_;$1.$,.$3/eg' file
    Updated: I originally missed the part about keeping the last letter as per Cody Pendant's comment below. Also, some words will be randomly mangled back to the same word and words less than four letters won't be changed.

    A shorter variation:

    perl -pe 's/(?<=\w)\w+(?=\w)/split$,,$&;my$s;$s.=splice@_,rand@_,1whi +le@_;$s/eg' file

    --
    John.

      Two characters shorter (64):

      perl -pe " s#(\w)(\w+)(\w)#join$,,$1,sort({(-1,1)[rand 2]}split$,,$2),$3#ge" #12345678 1 2345678 2 2345678 3 2345678 4 2345678 5 2345678 6 234

      It should be possible to golf that down some more, but I'm late for bed. (: Have fun.

                      - tye
        Again, hmm, this one always gets the right letters on the ends as far as I can see, but doesn't necessarily mangle all words. I just got:

        Aircnodcg to a researhecr at an Enigslh urisnviety, it doesn't matter in what order the ltertes in a wrod are.

        in which quite a few words went unmangled.

        ($_='kkvvttuubbooppuuiiffssqqffssmmiibbddllffss') =~y~b-v~a-z~s; print
        So all but first and last must be reordered, but nobody said they must be randomly scrambled. 35
        perl -pe 's/(?<=\w)(\w+)(?=\w)/(reverse$1)/eg' file 12345678901234567890123456789012345
        How about this:
        perl -pe 's#\B\w+\B#join$,,sort({(-1,1)[rand 2]}split$,,$&)#ge'
        That's 52 chars without the "perl -pe"
      Hmm, if I do this:
      $str = ' According to a researcher at an English university, it doesn\'t matter in what order the letters in a word are.'; $str =~ s/(\w)(\w+)/split"",$2;$,="";$,.=splice@_,rand@_,1while@_;$1.$ +,/eg; print $str;

      I get "Anogdcric to a reecasrreh at an Enghsli uyirenvist, it dnseo't matter in wtha oderr teh leettrs in a wdor are."

      Which doesn't fit the brief.

      Some words are not mangled, and nearly all of them have the wrong last letter.



      ($_='kkvvttuubbooppuuiiffssqqffssmmiibbddllffss') =~y~b-v~a-z~s; print
Re: Txet Maglning Glof, Ayobndy?
by greenFox (Vicar) on Sep 16, 2003 at 06:03 UTC
    You might want to take a look at scrmable.pl (from slashdot)

    --
    Do not seek to follow in the footsteps of the wise. Seek what they sought. -Basho

Re: Txet Maglning Glo, Ayobndy? (43?)
by BrowserUk (Pope) on Sep 16, 2003 at 06:32 UTC
    perl -pe"s/(?<=\b\w)(\w+)(?=\w)/$~=$1;chop($~).$~/eg" file

    Usual quote caveats.


    Examine what is said, not who speaks.
    "Efficiency is intelligent laziness." -David Dunham
    "When I'm working on a problem, I never think about beauty. I think only how to solve the problem. But when I have finished, if the solution is not beautiful, I know it is wrong." -Richard Buckminster Fuller
    If I understand your problem, I can solve it! Of course, the same can be said for you.

Re: Txet Maglning Glof, Ayobndy?
by Roger (Parson) on Sep 16, 2003 at 07:55 UTC
    Out of interest, I did a simple script to reverse the order of the letters (from 2nd to 2nd last), it's not random, but it does make the text look mangled...

    $s="According to a researcher at an English university"; print qq{@{[map{@:=split//;@:[1..$#:-1]=reverse@:[1..$#:-1];join"",@:} +$s=~m/(\w+)/g]}\n};
    The output has translated the string

    According to a researcher at an English university

    to the new string

    Anidroccg to a rehcraeser at an Esilgnh utisreviny

Re: Txet Maglning Glof, Ayobndy?
by Abigail-II (Bishop) on Sep 16, 2003 at 08:30 UTC
    A lot of the solutions reverse the inner part of the word. For many words, this scrambles the word, but it fails on words where the middle part is a palindrome, like motor. I believe that the following substitution doesn't suffer from such a problem, it will mangle all mangable words, and it won't loop on unmangable words:
    s/(\w)(\w)(\w+)(\w)/$1$3$2$4/;

    Abigail

      hmmm, can't won't isn't don't ?
      As pointed out, this misses apostrophes. I don't mind missing those. But we can chop even more.
      perl -pe 's:\B(\w)(\w+)\B:$2$1:g' # ------------------------ # 12345678 1 2345678 2 234

      --
      [ e d @ h a l l e y . c c ]

        It misses out on apostrophes because the original question didn't deal with them either. It wasn't specified how those should be handled. Note that it's fairly trivial to replace \w with [\w'], as long as you don't use \B or \b.

        Abigail

        Maybe I am doing something wrong, but I tried your one-liner and it does not work:
        perl -pe 's:\B(\w)(\w+)\B:$2$1:g' According to a research at an English university, it doesn't matter in + what orde r According to a research at an English university, it doesn't matter in + what orde r
        It just reprinted the exact same line I typed in.

        Celebrate Intellectual Diversity

Re: Txet Maglning Glof, Ayobndy?
by Caillte (Friar) on Sep 16, 2003 at 08:45 UTC

    Chipped a bit off ;)

    sub mangle { (@chars) = split '', shift; for($i=1;$i<$#chars-1;$i++){ next if(substr(join('',@chars), $i-1, 4) =~ / /); $buf=$chars[$i],$chars[$i]=$chars[$i+1],$chars[$i+1]=$buf if(rand( +10)>5); } return join '', @chars; }
    EDIT: Never go away for 10 minutes before posting on one of these posts... you will always submit and find 50 better versions than what you wrote before you ;)

    This page is intentionally left justified.

    janitored by ybiC: Replace <pre> tags around code snippet with <code> tags, as per Monastery convention

Re: Txet Maglning Glof, Ayobndy?
by tlhf (Scribe) on Sep 16, 2003 at 16:39 UTC
    This was my effort:
    perl -pe 's|(\w)(\w+)(?=\w)|$1.join"",sort{rand 2}split//,$2|ge' 12345678901234567890123456789012345678901234567890123 10 20 30 40 50 Edit: perl -pe 's|\B(\w+)\B|join"",sort{rand 2}split//,$1|ge'

    The golf has more perceptually random results than the other variants posted here which are shorted than it. It doesn't have an even distibution of results tho; words longer than 5 characters have certain permiatations which are more likely to come up. There's an example in the <readmore>.

    xxx

Re: Txet Maglning Glof, Ayobndy?
by OverlordQ (Hermit) on Sep 17, 2003 at 02:16 UTC
    Lol this is what I get for putting it into the CUFP Section, not that I'm an XP whore or anything :)
Re: Txet Maglning Glof, Ayobndy?
by devslashneil (Friar) on Sep 17, 2003 at 07:18 UTC
    Here is how i did it, i'm sure people have done it better.
    $ neil@m2 neil $ perl -e '(/(\w)(\w)(\w+)(\w)/ && print $1.$3.$2.$4." +") for @ARGV;' Hello World Hlleo Wrlod
    EDIT: This won't work with 3 letter words or change words like 'fool',

    Neil Archibald
    - /dev/IT -
Re: Txet Maglning Glof, Ayobndy?
by Anonymous Monk on Sep 17, 2003 at 20:46 UTC
    I tested it with the string "hey you", which is a common test string for me. Funny that I was surprised at the lack of results :)

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://291720]
Approved by tachyon
Front-paged by Courage
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (5)
As of 2014-04-19 13:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (480 votes), past polls