Welcome to the Monastery PerlMonks

### Re: (Efficiency Golf) Triangular numbers

by tachyon (Chancellor)
 on May 31, 2001 at 14:51 UTC ( #84515=note: print w/replies, xml ) Need Help??

in reply to (Efficiency Golf) Triangular numbers

Here is the code, commented and with follow the progress prints. There are ~35 code lines, the rest are comments, prints or whitespace. As hinted at in my short poem, the secret (such as there is one) is to analyse the problem. THREE must be a five digit number, but also it must be a 5 digit number that ends with the same two digits. With this we remove 90% of the possibles for the letters T-H-R-E, in fact there are a mere 27 in all as you can see if you run the code.

As we go we just push the possibilities for our letters into an array, we then split the letters out as required.

TEN uses the same T and E as found in T-H-R-E-E so we only need to search for N within the constraint of Ts and Es found initially. Once we have our possibles that satisfy T-H-R-E-N we look for ONE. Once again we only have to look for O within the constraint of the Ns and Es already generated.

At this stage there are only six possible combinations of digits for T-H-R-E-N-O. We get rid of 4 as they contain the same digit for two or more letters to leave just two. We then brute force the possibilities for SIX from the remaining 4 digits (only 4*3*2 = 24 cases) to get the answer.

Tachyon

#!/usr/bin/perl -w
use strict;
my $time = time(); my (%tri,@pos,@pos1,@pos2,@pos3); # make hash of tiangular numbers 5 digits or less # the 447th has 6 digits so we don't map past 446 map{$tri{.5*$_*($_+1)}=1}1..446;

# find all possible matches for 'three'
# these are 5 digits long, but last two digits are the same
# this allows us to limit the search
for my $key(keys %tri){ push @pos,$1 if $key =~/(\d\d\d(\d)\2)/; } # let's see how many possibilities we have print "Initially we have ".@pos." possibles for \$t\$h\$r\$e\$e\n";
print "$_\n" for @pos; # find all possible matches for 'ten' within constraint # of$t and $e possibilities generated above, we are looking for 'n' for (@pos) { my($t,$h,$r,$e)=split'',$_;
for my $n(0..9) { push @pos1, "$t$h$r$e$n" if defined $tri{"$t$e$n"}
}
}

# let's see how many possibilities we have left
print "\nNext we have ".@pos1." possibles for \$t\$h\$r\$e\$n\n"; print "$_\n" for @pos1;

#now look at 'one' in same way, we are looking for 'o'
for (@pos1) {
my($t,$h,$r,$e,$n)=split'',$_;
for my $o(0..9) { push @pos2, "$t$h$r$e$n$o" if defined$tri{"$o$n$e"} } } # let's see how many possibilities we have left print "\nNow we have ".@pos2." possibles for \$t\$h\$r\$e\$n\$o\n"; print "$_\n" for @pos2;

# remove dulicates where digits for $t$h$r$e$n$o are not unique
# I'm sure there is something more elegant but this works
for (@pos2) {
$_ =~ /(.)(.)(.)(.)(.)(.)/; push @pos3,$_ if $_=~m/[^$2$3$4$5$6][^$1$3$4$5$6][^$1$2$4$5$6][^$1 +$2$3$5$6][^$1$2$3$4$6][^$1$2$3$4$5]/; } # let's see how many possibilities we have left print "\nAfter removing cases where we have duplicate digits\n"; print "we have ".@pos3." possible matches for \$t\$h\$r\$e\$n\$o\n"; print "$_\n" for @pos3;

# find the solution
for my $pos(@pos3) { # get the remaining digits available for 'six' # we erase the 6 digits we are currently using # for t h r e n o my$remaining = '0123456789';
for (split'',$pos) {$remaining =~ s/$_//;} # look at the remaining cases print "\nBrute forcing\n"; print "If \$t\$h\$r\$e\$n\$o\ is$pos then \$s\$i\$x must come fro +m$remaining\n\n";
# brute force possibilities for six, it's only 4 digits
my @rem = split'',$remaining; for my$s(@rem){
i: for my $i(@rem){ next i if$i==$s; x: for my$x(@rem) {
next x if $x==$i or $x==$s;
if (defined $tri{"$s$i$x"}){
my($t,$h,$r,$e,$n,$o)=split'',$pos; # prove we are right! print "\nfound solution\n"; print "###################################\n"; print "one$o$n$e " if defined $tri{"$o$n$e"};
print "three $t$h$r$e$e " if defined$tri{"$t$h$r$
+e$e"}; print "six$s$i$x " if defined $tri{"$s$i$x"};
print "ten $t$e$n\n" if defined$tri{"$t$e$n"}; print "###################################\n\n"; } else {print "No match \$s\$i\$x -> $s$i$x\n"} } } } }$time = time()-$time; print "\nElapsed$time seconds\n";
[download]

If anyone has an elegant way of deleting the cases where we have duplicate characters I would love to see it. My 2 line regex is functional, but fairly agricultural!

Replies are listed 'Best First'.
Re: Re: (Efficiency Golf) Triangular numbers
by Abigail (Deacon) on May 31, 2001 at 19:12 UTC
Well, your "agricultural" regex could be written far much simpler, in a way even that doesn't hardcode the number of digits: ! /(\d).*\1/

I'm a bit surprised to see an idiom in your program that another solution also used:

    foreach (@array) {
push @other, $_ if some_condition; } [download] Of course, that's much clearer, and more efficiently, written as:  @other = grep {some_condition} @array; [download] -- Abigail Re: Re: (Efficiency Golf) Triangular numbers by Zaxo (Archbishop) on Jun 01, 2001 at 00:06 UTC If anyone has an elegant way of deleting the cases where we have duplicate characters I would love to see it. My 2 line regex is functional, but fairly agricultural! I won't claim elegance, but above I constructed character classes on the fly for that. Each partial solution like ($T,$H,$R,$E,$N) is used to form "[^$T$H$R$E$N]". That is applied to 3-digit candidates which are already filtered for unlike digits. After Compline Zaxo Update: Rereading your statement, I saw I'd filtered that too :-) I used$_ !~ m/(\d)\d*\1/g to filter out matching digits.

Create A New User
Node Status?
node history
Node Type: note [id://84515]
help
Chatterbox?
 [tye]: -Mouse [Corion]: Option a) would mean launching cmd.exe /k c:\path\to\ batchfile- launching-perl- script.cmd. Option b) would be to add pause as the last line of said batch file. [LanX]: First day after holidays ... and already stressed by the fact that colleagues changed stuff without communication ... apparently I'm the only one trying to fight entropy [Corion]: LanX: The command is always in the history if you typed it in before. If you didn't type the command into the command line, it will not be there. I think there is doskey which can stuff command lines into the history LanX damns the cult of CB ;-) LanX WTF WTF WTF [LanX]: please forget my last 3 posts [LanX]: Yeah option a doesn't go into history [LanX]: probably I need to teach the app to restart after C-c Kill [Corion]: LanX: Maybe have an infinite-loop cmd file? Much easier than trying to manage that from within Perl IMO

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (9)
As of 2017-03-27 15:48 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
Should Pluto Get Its Planethood Back?

Results (320 votes). Check out past polls.