Perl Weekly Challenge 289: Jumbled Letters

These are some answers to the Week 289, Task 2, of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on October 6, 2024, at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 2: Jumbled Letters

An Internet legend dating back to at least 2001 goes something like this:

Aoccdrnig to a rscheearch at Cmabrigde Uinervtisy, it deosn't mttaer in waht oredr the ltteers in a wrod are, the olny iprmoetnt tihng is taht the frist and lsat ltteer be at the rghit pclae. The rset can be a toatl mses and you can sitll raed it wouthit porbelm. Tihs is bcuseae the huamn mnid deos not raed ervey lteter by istlef, but the wrod as a wlohe.

This supposed Cambridge research is unfortunately an urban legend. However, the effect has been studied. For example—and with a title that probably made the journal’s editor a little nervous—Raeding wrods with jubmled lettres: there is a cost by Rayner, White, et. al. looked at reading speed and comprehension of jumbled text.

Your task is to write a program that takes English text as its input and outputs a jumbled version as follows:

1. The first and last letter of every word must stay the same
2. The remaining letters in the word are scrambled in a random order (if that happens to be the original order, that is OK).
3. Whitespace, punctuation, and capitalization must stay the same
4. The order of words does not change, only the letters inside the word

So, for example, “Perl” could become “Prel”, or stay as “Perl,” but it could not become “Pelr” or “lreP”.

I don’t know if this effect has been studied in other languages besides English, but please consider sharing your results if you try!

For this task, I will look for punctuation marks at the end of words. If a non-alphanumeric character occurs in the middle of a word (such as an apostrophe as in "don't" or a dash), I'll consider it as an ordinary letter subject to scrambling with other letters. It would not be difficult to consider these characters as punctuation marks and keep them in place, if we wanted it this way.

Jumbled Letters in Raku

First, we split the input string into words, using the words method. Then, we split each words into individual characters. If the word ends with a punctuation mark, we set it aside (in the $punctuation variable) and remove it from our list of letters. Then, we scramble the inner letters using the pick method on a slice of the letter array. With a parameter * (or a number greater than or equal to the size of the invocant list), pick returns the elements of the invocant list shuffled. Then we replace the original array slice with the shuffled items. Finally, we add the word to the @out array. Finally, once we have processed all words of the input string, we return a string joining all the words of the @out array.

sub jumble-letters ($in) {
    my @out;
    for $in.words -> $word {
        my @letters = $word.comb;
        my $punctuation = "";
        $punctuation = @letters.pop if $word ~~ /.*\W$/;
        @letters[1..*-2] = @letters[1..*-2].pick: *;
        my $out-word = (join "", @letters) ~ $punctuation;
        push @out, $out-word;
    }
    return join " ", @out;
}

my @tests = "Ask not what your country can do for you, ask what you can do for your country", 
            "I have a dream that one day this nation will rise up and live out the true meaning of its creed.",
            "The greatest thing you will ever learn is just to love and be loved in return.";
for @tests -> $test {
    say $test;
    say jumble-letters $test;
    say "";
}

This program displays the following output:

$ raku ./jumble-letters.raku
Ask not what your country can do for you, ask what you can do for your country
Ask not waht your coturny can do for you, ask waht you can do for your ctnruoy

I have a dream that one day this nation will rise up and live out the true meaning of its creed.
I hvae a draem that one day tihs naotin will rsie up and lvie out the true mannieg of its ceerd.

The greatest thing you will ever learn is just to love and be loved in return.
The geastret tihng you wlil ever lrean is jsut to lvoe and be leovd in ruretn.

We can observe that the first test case (quote from JFK) is made mostly of short words which undergo no or little changes, and its result is therefore quite readable. In the two other cases (sentences by Martin Luther King and Nat King Cole) which contain more longer words, the output is quite difficult to read.

Jumbled Letters in Perl

This is a port to Perl of the above Raku program. Please read the program description in the section above if you need further explanations. Since Perl doesn't have a pick built-in, we use a while loop to manually select random letters from the input list. I don't know if this is a good random shuffling, but I don't really care, as we don't need strong randomness (this is not cryptography).

use strict;
use warnings;
use feature 'say';

sub jumble_letters {
    my $in = shift;
    my @out;
    for my $word (split /\s+/, $in) {
        my @letters = split //, $word;
        my $punctuation = "";
        $punctuation = pop @letters if $word =~ /.*\W$/;
        my @inner_letters = @letters[1..$#letters-1];
        my @scrambled;
        while (@inner_letters) {
            my $index = int rand scalar @inner_letters;
            push @scrambled, $inner_letters[$index];
            splice @inner_letters, $index, 1;  
        }
        @letters[1..$#letters-1] = @scrambled;
        my $out_word = (join "", @letters) . $punctuation;
        push @out, $out_word;
    }
    return join " ", @out;
}

my @tests = ( "Ask not what your country can do for you, ask what you can do for your country", 
              "I have a dream that one day this nation will rise up and live out the true meaning of its creed.",
              "The greatest thing you will ever learn is just to love and be loved in return.");
for my $test (@tests) {
    say $test;
    say jumble_letters $test;
    say "";
}

This program displays the following output:

$ perl ./jumble-letters.pl
Ask not what your country can do for you, ask what you can do for your country
Ask not waht yuor cnrtuoy can do for you, ask waht you can do for your cornuty

I have a dream that one day this nation will rise up and live out the true meaning of its creed.
I hvae a daerm that one day tihs ntoain wlil rise up and live out the true mneanig of its cered.

The greatest thing you will ever learn is just to love and be loved in return.
The getsaert tihng you will eevr learn is jsut to love and be loevd in rrtuen.

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on October 13, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

Leave a comment

About laurent_r

user-pic I am the author of the "Think Perl 6" book (O'Reilly, 2017) and I blog about the Perl 5 and Raku programming languages.