Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Word Math

by YuckFoo (Abbot)
on Oct 09, 2008 at 16:52 UTC ( #716257=CUFP: print w/replies, xml ) Need Help??

The boy learned about variables the other day and thought it was cool how letters could stand for numbers. I was reminded of the word math puzzles I had seen where you have to figure out what digit each letter represents to make a valid math problem, like:
one + four ======== five
spec + perl ======== opus
And so became the word math program. It's just a brute force thing, but kinda cool.

Yuck+Foo

#!/usr/bin/perl use strict; use Data::Dumper; my $DictFile = '/usr/share/dict/words'; my $MinLen = 3; my $MaxLen = 6; my $Todo = 10; my $Hint = 1; my $dict = read_dict($DictFile, $MinLen, $MaxLen); #my $dict = read_data($MinLen, $MaxLen); my $pre_selects = (@ARGV) ? [@ARGV] : []; while ($Todo) { my $words = choose_words($dict, $pre_selects); my $numbs = encode_words($words); if ($numbs) { ($words, $numbs) = sort_lists($words, $numbs); if ($numbs->[0] + $numbs->[1] == $numbs->[2]) { $Todo--; show_it($MaxLen, $words, $numbs, $Hint); } } } #----------------------------------------------------------- sub show_it { my $len = shift; my $words = shift; my $numbs = shift; my $hint = shift; $hint = ($hint) ? make_hint($words, $numbs) : ''; printf " %*s\n", $len, $words->[0]; for my $i (1..@$words-2) { printf "+ %*s\n", $len, $words->[$i]; } printf "==%s\n", '=' x $len; printf " %*s $hint\n\n", $len, $words->[-1]; } #----------------------------------------------------------- sub make_hint { my $words = shift; my $numbs = shift; my $w_str = join('', @$words); my $n_str = join('', @$numbs); my $r = rand(length($w_str)); my $w = substr($w_str, $r, 1); my $n = substr($n_str, $r, 1); return "($w = $n)"; } #----------------------------------------------------------- sub sort_lists { my $words = shift; my $numbs = shift; my @list; for my $i (0..@$numbs - 1) { push @list, { i => $i, numb => $numbs->[$i], }; } @list = sort { $a->{numb} <=> $b->{numb} } @list; my (@new_words, @new_numbs); while (my $i = shift(@list)) { push @new_words, $words->[$i->{i}]; push @new_numbs, $numbs->[$i->{i}]; } return (\@new_words, \@new_numbs); } #----------------------------------------------------------- sub encode_words { my $words = shift; my %letters; my @numbs; for my $word (@$words) { for my $char (split('', $word)) { $letters{$char}++; } } my @letters = keys(%letters); (@letters > 9) and return; my @digits = (0..9); my %xlate = {}; while (my $letter = splice(@letters, rand(@letters), 1)) { $xlate{$letter} = splice(@digits, rand(@digits), 1); } for my $word (@$words) { my $numb; for my $char (split('', $word)) { $numb .= $xlate{$char}; } push @numbs, $numb; } return \@numbs; } #----------------------------------------------------------- sub choose_words { my $dict = shift; my $words = shift; my @list = @$words; while (@list < 3) { push @list, $dict->[rand(@$dict)]; } return \@list; } #----------------------------------------------------------- sub read_dict { my $file = shift; my $min = shift; my $max = shift; my @words; open (my $fh, '<', $file) or die; while (my $line = <$fh>) { chomp $line; (length($line) < $min) and next; (length($line) > $max) and next; ($line =~ tr/A-Z/A-Z/) and next; push @words, $line; } return \@words; } #----------------------------------------------------------- sub read_data { my $min = shift; my $max = shift; my @words; while (my $line = <DATA>) { chomp $line; (length($line) < $min) and next; (length($line) > $max) and next; ($line =~ tr/A-Z/A-Z/) and next; push @words, $line; } return \@words; } __DATA__ zero one two three four five six seven eight nine ten eleven twelve thirteen fourteen fifteen sixteen seventeen eighteen nineteen twenty

Replies are listed 'Best First'.
Re: Word Math
by sflitman (Hermit) on Oct 10, 2008 at 17:51 UTC
    Very cool. For ActivePerl on Win32, I'd add code to detect windows and choose an alternate path for the dictionary.
    my $DictFile = $^O eq 'MSWin32' ? "C:\\Program Files\\Shared Files\\words.txt" : '/usr/share/dict/words';
    I of course just downloaded /usr/share/dict/words from my server and renamed it. Nice job! SSF

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://716257]
Approved by moritz
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (3)
As of 2016-09-25 19:14 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Extraterrestrials haven't visited the Earth yet because:







    Results (472 votes). Check out past polls.