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

Finding vowels in a cryptogram

by tall_man (Parson)
on Jun 06, 2003 at 20:33 UTC ( [id://263851]=perlquestion: print w/replies, xml ) Need Help??

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

One way of starting to solve simple-substitution cryptograms is to try to find the vowels. I look for high-frequency letters that tend not to contact each other very frequently. (I've seen other approaches to crytograms here, like merlyn's pat program, but nothing for vowels).

I would like to automate the process of finding vowels, and it seems like a tree cluster analysis algorithm might work, as described on this page.

The distance measure is a little tricky. I would like the distance measure from letter 'x' to letter 'y' to be a percent disagreement, (perhaps number of times 'x' contacts 'y' over the total number of contacts for 'x' and 'y'). (The more contacts the greater the distance, since I am looking for letters that avoid each other).

I took a look at Algorithm::Cluster, but it doesn't seem to be directly applicable to this case. It's more for genetic data with real-number values.

Here is my starting code, (just getting the single-letter and digram frequencies). Any suggestions on modules I could use to help solve this?

use strict; use Statistics::Frequency; use FileHandle; use Data::Dumper; sub simplifyText { my $txt = shift; $txt =~ s/\s+/ /g; $txt =~ tr/A-Z/a-z/; $txt =~ tr[.(),/:][]d; return $txt; } my $f1 = Statistics::Frequency->new; my $fn = "/net/fox/vol02/tallman/notes/dynamac"; my $fh = new FileHandle("<" . $fn); defined $fh or die "Cannot open $fn: $!\n"; local $/ = undef; my $text = <$fh>; $text = simplifyText($text); print "text *$text*\n"; my @txt = split //,$text; my @txt_nospaces = grep { $_ ne ' ' } @txt; $f1->add_data(\@txt_nospaces); my $f2 = Statistics::Frequency->new; my $last = undef; my $letter; my @pairs = (); foreach $letter (@txt) { if ($letter eq ' ') { $last = undef; next; } push @pairs,($last . $letter) if defined $last; $last = $letter; } $f2->add_data(\@pairs); my %freq = $f1->frequencies; print Data::Dumper->Dump([\%freq],["*freq"]); my %freq2 = $f2->frequencies; print Data::Dumper->Dump([\%freq2],["*freq2"]);

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (5)
As of 2024-03-28 23:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found