Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Lewis Carroll's Code

by Cody Pendant (Prior)
on Jul 18, 2002 at 00:32 UTC ( [id://182663]=perlquestion: print w/replies, xml ) Need Help??

Cody Pendant has asked for the wisdom of the Perl Monks concerning the following question:

My Fellow Monks,

I was reading a book the other day in which the characters use "Lewis Carroll's Code".

This is, apparently, a cypher based on a keyphrase using the following scheme.

The keyphrase is written vertically down your paper:
J
U
S
T
A
N
O
T
H
E
R

and so on.

Then the alphabet is written across, starting with each letter:

ABCDEFGHIJKLMNOPQRSTUVWXYZ -------------------------- JKLMNOPQRSTUVWXYZABCDEFGHI UVWXYZABCDEFGHIJKLMNOPQRST (etc.)

To encode, you find your first letter in the line beginning with J, and look up to the regular-alphabet line. If your letter is "P", it becomes "G". Then you find the next letter on the line beginning with U -- "E" becomes "T".

Below is my implementation of this in Perl.

I would really like your comments.

This is the first time I've tried to make a proper piece of Perl which has error messages and follows strict rules and could conceivably be used by someone else.

I know that as an encryption scheme goes it's pretty much useless, but as an exercise in writing Good Perl, how have I done?

TIA

use strict; use warnings; print "Encode (E) or Decode (D)?\n"; my $choice = <STDIN>; if ( $choice =~ /e/i ) { print "What's the key-phrase:\n"; my $key_phrase = <STDIN>; chomp($key_phrase); print "What's the text to encode:\n"; my $clear_text = <STDIN>; chomp($clear_text); print " '$clear_text' \nencoded using \n '$key_phrase'\nresult:\n " +; print &amp;amp;amp;amp;encode_lcc( $clear_text, $key_phrase ), "\n +"; } elsif ( $choice =~ /d/i ) { print "What's the key-phrase:\n"; my $key_phrase = <STDIN>; chomp($key_phrase); print "What's the text to decode:\n"; my $cypher_text = <STDIN>; chomp($cypher_text); print " '$cypher_text' \ndecoded using \n '$key_phrase'\nresult:\n +"; print &amp;amp;amp;amp;decode_lcc( $cypher_text, $key_phrase ), "\ +n"; } else { print "Entry must be D or E\n"; exit; } sub encode_lcc { my $alpha = 'abcdefghijklmnopqrstuvwxyz'; my ( $clear_text, $key_phrase ) = @_; unless ( $clear_text &amp;amp;amp;amp;&amp;amp;amp;amp; $key_phras +e ) { die "Wrong number of arguments. Syntax: encode_lcc(CLEARTEXT,KEYPHRASE)"; } $key_phrase =~ tr/A-Z/a-z/; my @key_array = $key_phrase =~ /[a-z]/gi; my $i = 0; my $output = ''; foreach ( split ( '', $clear_text ) ) { if (/[^a-z]/i) { $output .= $_; } else { $output .= substr( $alpha, ( index( $alpha, lc($_) ) - index( $alpha, $key_array[$i] ) ), 1 ) ; # encoded output is the letter in the alphabet found a +t: # (letter's normal position) minus (letter-position of # the current keyphrase-letter) $i = ( ( $i + 1 ) % @key_array ); } } return $output; } sub decode_lcc { my $alpha = 'abcdefghijklmnopqrstuvwxyz'; my ( $cypher_text, $key_phrase ) = @_; unless ( $cypher_text &amp;amp;amp;amp;&amp;amp;amp;amp; $key_phra +se ) { die "Wrong number of arguments. Syntax: encode_lcc(CYPHERTEXT,KEYPHRASE)"; } $key_phrase =~ tr/A-Z/a-z/; my @key_array = $key_phrase =~ /[a-z]/gi; my $i = 0; my $output = ''; foreach ( split ( '', $cypher_text ) ) { if (/[^a-z]/i) { $output .= $_; } else { $output .= substr( $alpha, ( ( index( $alpha, lc($_) ) + index( $alpha, $key_array[$i] ) ) % 26 ), 1 ) ; # decoded output is the letter in the alphabet found a +t: # (letter's normal position) plus (letter-position of # the current keyphrase-letter), mod 26 to stop us # going past the end of the alphabet. $i = ( ( $i + 1 ) % @key_array ); } } return $output; }

Update: (myocom) Added the rest of Cody_Pendant's description per his request.

--
($_='jjjuuusssttt annootthheer pppeeerrrlll haaaccckkeer')=~y/a-z//s;print;

Replies are listed 'Best First'.
Re: Lewis Carroll's Code
by cacharbe (Curate) on Jul 18, 2002 at 01:03 UTC
Re: Lewis Carroll's Code
by Cody Pendant (Prior) on Jul 18, 2002 at 02:14 UTC
    Here are some thoughts I had about my code:
    • I get the feeling, looking at $alpha = 'abcdefghijklmnopqrstuvwxyz'; that it could be done in some much smarter way, but I can't think what exactly; any ideas?
    • I could use an array for the alphabet, @alpha = (a..z); but I can do the equivalent of substr() on an array, what's the equivalent of index() when it comes to arrays?
    • This implementation doesn't preserve case, can anyone see an easy way to make it preserve case?

    --
    ($_='jjjuuusssttt annootthheer pppeeerrrlll haaaccckkeer')=~y/a-z//s;print;
      You might want to consider something like:
      my @abc = ('a'..'z'); my %abc = map { ($abc[$_],$_) } (0..25); my @key = map { $abc{ lc() } } $key =~ /([a-z])/ig;
      To use it, loop through the characters in your message any way you like. The following assumes you have the current letter in $c , that $i holds your position in @key , and that the result will be in $result . . .
      my $new_c; if ($c =~ /[a-z]/i) { $new_c = $abc[($abc{lc($c)} + $key[$i]) % 26]; $new_c = uc($new_c) if ($c =~ /[A-Z]/); $result .= $new_c; $i = ($i + 1) % @key; } else { $result .= $c; }
      You could use the same code above for decoding if you changed @key to hold negative numbers instead of positives.
      
      -sauoq
      
      "My two cents aren't worth a dime.";
      
      grep may be what you are looking for. it uses a regex rather than a string though:

      From the perldoc:

      grep BLOCK LIST grep EXPR,LIST This is similar in spirit to, but not the same as, grep(1) and its relatives. In particular, it is not limited to using regular expressions. Evaluates the BLOCK or EXPR for each element of LIST (locally setting "$_" to each element) and returns the list value consisting of those ele­ments for which the expression evaluated to true. In scalar context, returns the number of times the expression was true. @foo = grep(!/^#/, @bar); # weed out comments or equivalently, @foo = grep {!/^#/} @bar; # weed out comments

      Hope that helps
      Chris

      Lobster Aliens Are attacking the world!
        I'm confused -- what is it you want me to use GREP for?
        --
        ($_='jjjuuusssttt annootthheer pppeeerrrlll haaaccckkeer')=~y/a-z//s;print;
Re: Lewis Carroll's Code
by Cody Pendant (Prior) on Jul 18, 2002 at 01:13 UTC
    Oh just spotted an error, just in case you noticed: Then you find the next letter on the line beginning with U -- "E" becomes "T". should read "E" becomes "K" of course.
    --
    ($_='jjjuuusssttt annootthheer pppeeerrrlll haaaccckkeer')=~y/a-z//s;print;
Re: Lewis Carroll's Code
by rjray (Chaplain) on Jul 18, 2002 at 00:50 UTC

    An interesting cipher, though I wouldn't entrust Enron's accounting records to it :-).

    It does seem that is should be possible to combine the encode/decode functionality into one routine. Though I do like the using the mod-operator to wrap around the alphabet and avoid generating the permuted substitution lines.

    --rjray

Re: Lewis Carroll's Code
by Cine (Friar) on Jul 18, 2002 at 11:31 UTC
    if ( $choice =~ /e/i ) { is not a good choice for single letter input, because you a checking a whole line. Thus if I as user write "v7dhu" because her hand fell unto the keyboard it would be read as if I wanted to decode something. Use if ($choice eq 'e' || $choice eq 'E') { instead (remember to chomp $choice), this also makes it clear that you are looking for specific input, when someone else is reading your code...

    T I M T O W T D I

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://182663]
Approved by zejames
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others surveying the Monastery: (4)
As of 2024-03-29 12:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found