Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

poqui's scratchpad

by poqui (Deacon)
on Jun 01, 2004 at 19:05 UTC ( #358414=scratchpad: print w/ replies, xml ) Need Help??

I named this "enbous.pl" on my filesystem because it was inspired by a puzzle and resembles (only in *my* mind) boustrophedontic text (that is text that travels back and forth across the page instead of only left to right or right to left).

I say "only in *my* mind" because what this actually does is take a file, strips all but the letters, and scrambles them in a 1 to 3 line pattern based on the priming number.

Visualize a 3 by 3 grid; then think of the numbers 1 thru 9 as instructions: then you have an idea of how the priming number works. I'll try to illustrate.

-------
|1|2|3|
-------
|4|5|6|
-------
|7|8|9|
-------
Thats the grid above. If you entered the priming number "123456789", that is how the letters of the input file would be arranged in the output, but there is one more twist. Lets say the phrase is simply 9 letters: "The Lean To". With the priming number 123456789, it would come out:
The
Lea
nTo
phrases with more letters would snake around like this:
The|sti|ust
Lea|nro|s
nTo|ofr
"The Lean To's tin roof rusts"
(the pipes are to seperate thigs for extra clarity)

The puzzle that inspired this madness would have used a priming number of "41532"; and the same phrase would come out thusly:
LT|oa|rt|uo|t
e |s |o |s |
eh|Tn|ni|rf|s
or without the pipes
LToartuot
esos
ehTnnirfs

The only other weirdness is that when parsing the priming number, the program tries to fulfill 3 lines of output; so the only way to get "plaintext" is to only enter "1".
"12" will give 2 lines alternating letters between them. And "123" will give 3 lines.
#!/usr/bin/perl use strict; use warnings; use POSIX qw(strftime); use Data::Dumper; undef $/; # slurp the entire input file in one shot my $arglen = length($ARGV[0]); die "USAGE: {priming number} {input text file name}\n" unless ($ARGV[0 +]); die "must supply 1-9 digit number with no zeroes as first argument\n" +unless ($ARGV[0] =~ /[1-9]{$arglen}/); die "must supply file name as second argument\n" unless ($ARGV[1]); my @pattern = split //, $ARGV[0]; my $i; my $j; for ($i =0;$i<$#pattern;$i++) { for ($j = $i+1;$j<$#pattern;$j++) { die "all digits in priming number must be unique\n" unless $pa +ttern[$i] != $pattern [$j]; } } open TXTIN, "<$ARGV[1]" or die "Can't open input text file $ARGV[1]: $ +!"; my $inputblob = <TXTIN>; close TXTIN; $inputblob =~ tr/a-zA-Z//cd; #strip out everything but letters my @plain = split //, $inputblob; my $range = int($#plain / ($#pattern+1)) + ($#plain % ($#pattern+1) ? +1 : 0); my $line1; my $line2; my $line3; # print " plain:", $inputblob, "\n", "plain:pattern:range:", $#plain, +":", $#pattern, ":", $range,"\n\n"; for (my $k= 0; $k < $range; $k++) { # every time $line1 .= $plain[($pattern[0]-1)+($k*$arglen)] unless (($patter +n[0]-1)+($k*$arglen) > $#plain); if ($#pattern < 4) { $line2 .= $plain[($pattern[1]-1)+($k*$arglen)] unless (($pa +ttern[1]-1)+($k*$arglen) > $#plain); } if ($#pattern < 3) { $line3 .= $plain[($pattern[2]-1)+($k*$arglen)] unless (($pa +ttern[2]-1)+($k*$arglen) > $#plain); } if ($#pattern > 2) { if ($#pattern < 5) { $line3 .= $plain[($pattern[3]-1)+($k*$arglen)] unless ( +($pattern[3]-1)+($k*$arglen) > $#plain); } if ($#pattern < 7) { $line2 .= $plain[($pattern[2]-1)+($k*$arglen)] unless ( +($pattern[2]-1)+($k*$arglen) > $#plain); } } if ($#pattern > 3) { $line1 .= $plain[($pattern[1]-1)+($k*$arglen)] unless (($pa +ttern[1]-1)+($k*$arglen) > $#plain); if ($#pattern < 7) { $line3 .= $plain[($pattern[4]-1)+($k*$arglen)] unless ( +($pattern[4]-1)+($k*$arglen) > $#plain); } } if ($#pattern > 4) { $line2 .= $plain[($pattern[3]-1)+($k*$arglen)] unless (($pa +ttern[3]-1)+($k*$arglen) > $#plain); if ($#pattern < 8) { $line3 .= $plain[($pattern[5]-1)+($k*$arglen)] unless ( +($pattern[5]-1)+($k*$arglen) > $#plain); } } if ($#pattern > 5) { $line2 .= $plain[($pattern[4]-1)+($k*$arglen)] unless (($pa +ttern[4]-1)+($k*$arglen) > $#plain); $line3 .= $plain[($pattern[6]-1)+($k*$arglen)] unless (($pa +ttern[6]-1)+($k*$arglen) > $#plain); } if ($#pattern > 6) { $line1 .= $plain[($pattern[2]-1)+($k*$arglen)] unless (($pa +ttern[2]-1)+($k*$arglen) > $#plain); $line3 .= $plain[($pattern[7]-1)+($k*$arglen)] unless (($pa +ttern[7]-1)+($k*$arglen) > $#plain); } if ($#pattern > 7) { $line2 .= $plain[($pattern[5]-1)+($k*$arglen)] unless (($pa +ttern[5]-1)+($k*$arglen) > $#plain); $line3 .= $plain[($pattern[8]-1)+($k*$arglen)] unless (($pa +ttern[8]-1)+($k*$arglen) > $#plain); } } # print Dumper(\@plain); print $line1, "\n"; print $line2, "\n"; print $line3, "\n\n";
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (4)
As of 2014-09-16 03:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite cookbook is:










    Results (155 votes), past polls