Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation

(Efficiency Golf) Triangular numbers

by jepri (Parson)
on May 30, 2001 at 09:08 UTC ( #84175=perlmeditation: print w/replies, xml ) Need Help??

Every month New Scientist magazine publishes a little mathematical challenge. Normally these things irritate me because they rely on some cute but irrelevant mathematical trick. This month, however, they have tried to obscure the question by replacing numbers with letters, which makes it a Perlish challenge. Here we go:

A triangular number is a term from the sequence generated by this equation (in Perl):

foreach my $n (1..1000) { $x=.5*$n*($n+1); print $x; }

This gives 1, 3, 6, 10 and so on. This months challenge is to find a certain four numbers from this sequence. They don't give us the numbers, but they have substituted letters for digits of these numbers, and made words from them. The words are: ONE, THREE, SIX and TEN.

So for instance, we could have O=1, N=2, E=3, and the first number would be 123.

So I wrote a Perl program to have a go at it. I make a hash of the letters, assign a value (starting at zero) to each letter, then start incrementing. It's been going for the last few hours and I just realised it could take quite a long time to finish.

I am declaring that the challenge is to make it efficient, not write it with the fewest characters. This is not part of the official challenge, if you feel like writing it in one line, go right ahead.

The prize is drawn on the 28 June


jeroenes asked if there were restrictions on the numbers - there are. It's one letter for one digit. The digits may be 0..9 (the article is a little vague on this, but that's my reading). But I forgot to mention that none of the numbers start with a zero. i.e. 003 is not a valid solution for this challenge

The challenge does not mention the order of the numbers, so I guess we can assume 'any'.

If you would also like to apply for the 15-pound prize you can send your solution to (include your postal address)

#!/usr/bin/perl use strict; my @words=('ONE', 'THREE', 'SIX', 'TEN'); my %letters; foreach (@words) { my @a=split //, $_; foreach (@a) { $letters{$_}=0; } } #Construct an array of the letters (you'll see why #in a few lines) my @letters=(keys %letters); my $count; my $oldtime; do { $letters{$letters[$#letters]}++; foreach( reverse(0..$#letters)) { if ($count++>10000) { print time-$oldtime,"\n"; $oldtime=time; $count=0; } #Increment the number for the letter at the end #of the array, and don't forget to carry if ($letters{$letters[$_]} > 9) { $letters{$letters[$_]}=0; $letters{$letters[$_-1]}++; } #Turn the letters into numbers prep(%letters); } } until ($letters{$letters[0]} > 9); sub prep { my %letters=@_; my $match=0; my %match; foreach my $a (@words) { my $test= $a; #Change the letters into numbers foreach (keys %letters) { $test=~ s/$_/$letters{$_}/g; } $match{"$a=$test is triangular\n"}=1 and $match ++ if is_triangular +($test); } if ($match>0) { # print "-----------\n"; if ($match>(@words-1)) { print $_ foreach keys %match; print "Found it!\n"; #exit; } } } #This should be memoised, but I'm afraid of the #memory blowout sub is_triangular { my $num=shift; my ($n,$x)=(1,0); do { $x=.5*$n*(++$n); return 1 if $x==$num; } until $x > $num; return 0; }

Update II

Since tachyon has indeed beaten me to the answer I shall enter PerlMonks in the competetion, winnings go in the plate. (More likely they will go into an envelope and off to vroom).

Update III

My bad. The challenge for the magazine is to get the answer. The answers are then drawn out of a hat, first right one gets the prize.

My challenge to you is to do it most efficiently.

I didn't believe in evil until I dated it.

Replies are listed 'Best First'.
Re: (Efficiency Golf) Triangular numbers
by Abigail (Deacon) on May 30, 2001 at 17:58 UTC
    There is no need for the program to run very long. A paper and pencil puzzler will beat your 'running for many hours' program.

    I will not post the solution here, but I will provide a link to the program. It's about 80 lines, but more than half of the lines are comments.

      I'm familiar with assigning to slices of a hash, and its use in this line:

      @seen {$t, $h, $r, $e} = ();

      was very clever. However, why did you use slices in these lines?

      @seen {$n,} = (); .... @seen {$o,} = ();
      Aren't they equivalent to:
      $seen{$n} = undef; $seen{$o} = undef;
      Or even just:
      @seen {$n} = (); # note the lack of comma after $n .... @seen {$o} = ();
      I guess its that trailing comma that looks odd to me.

      p.s. props on the @HIGH and @LOW generation... very sneaky!

        I used @seen {$n,} = (); and not $seen {$n} = undef; because I used the slice in the other case as well. I wanted to use as much identical syntax as possible, and didn't see a reason to special case adding a single key.

        As for using a trailing comma, all I can say is that using -w is useful. If you use it, you'll see why the comma was used.

        -- Abigail

Re: (Efficiency Golf) Triangular numbers
by tachyon (Chancellor) on May 30, 2001 at 14:03 UTC

    Looks like we may need benchmark for this game. Here is the answer, I'll post the complete code in 24 hours so as not to spoil all the fun. It's ~ 30 average lines long and runs under strict. I have included the begining and end. My woodwork teacher used to say look after the edges and the middle will look after itself..... BTW Please enter perlmonks for the prize and donate it to the offering plate when we win!


    There is only one solution,

    brute force is not the key

    With code in evolution,

    consider the holy three



    one 435 three 17955 six 820 ten 153 Elapsed 0 seconds #!/usr/bin/perl -w use strict; my $time = time(); my %tri; # make hash of tiangular numbers 5 digits or less map{$tri{.5*$_*($_+1)}=1}1..446; ... ... # prove we are right! 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"}; $time = time()-$time; print "Elapsed $time seconds\n";
Re: (Efficiency Golf) Triangular numbers
by jeroenes (Priest) on May 30, 2001 at 09:59 UTC
    Is there any constraint on the way the letters form the numbers? Like, did they state that the letters code for the numbers 0..9 in an unknown order? Can it also be that they code for 0..25 each? Or can they encode say 1000..1025, but are always in the same order?


Re: (Efficiency Golf) Triangular numbers
by tachyon (Chancellor) on May 30, 2001 at 16:03 UTC

    For those who are impatient I ran my code through the obfu engine...


    my$time=time();local$";map{$t{.5*$_*($_+1)}=1}1..446;map{ push@p,$1 if/(...(.)\2)/}keys%t;map{@a[0..3]=split'';map{ push@p1,"@a$_"if defined$t{"$a[0]$a[3]$_"}}0..9}@p;map{@a =split'';map{push@p2,"@a$_"if defined$t{"$_$a[4]$a[3]"}} 0..9}@p1;map{/(.)(.)(.)(.)(.)(.)/;push @p3,$_ if/[^$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]/x;}@p2;for(@p3){$r='0123456789';$r=~s/$_// for split'';@r=split'',$r;for$a(@r){for$b(@r){next if$b== $a;for$c(@r){next if$c==$b or$c==$a;if(defined$t{"$a$b$c"}) {@a=split'';$w="one:$a[5]$a[4]$a[3] three:$a[0]$a[1]$a[2]" ."$a[3]$a[3] six:$a$b$c ten:$a[0]$a[3]$a[4]\n"}}}}}$time= time()-$time;print$w."Elapsed time $time seconds\n";
Re: (Efficiency Golf) Triangular numbers
by Zaxo (Archbishop) on May 30, 2001 at 23:13 UTC

    I've pasted in the full program and its output. The strategy is to preselect the numbers to consider by populating arrays with only the triangular numbers which match the pattern of digits implied by 'THREE' and friends. Then I look for pairs of 5 and 3 digit numbers which can correspond to 'THREE' and 'TEN'. That leaves just two pairs, which speeds the search for 'ONE' and 'SIX' a lot.

    This isn't very general or clever, just gets the job done.

    Full Output:

    There are 31 three digit triangular numbers There are 307 five digit triangular numbers There are 26 three digit ones which lack matching digits. There are 9 five digit ones matching the pattern 'THREE'. THREE: 17955 ONE: 435 SIX: 820 TEN: 153 Elapsed time: 0.02 0 0 0

    Full Listing:

    #!/usr/bin/perl -w # -*-Perl-*- use strict; sub triangular { use integer; my $n=shift; $n*($n+1)/2; } my @threedigit = map triangular($_), (int(sqrt(2*100))*1000))); my @fivedigit = map triangular($_), (int(sqrt(2*10000))*100000))); print "There are ".scalar @threedigit." three digit triangular numbers +\n"; print "There are ".scalar @fivedigit." five digit triangular numbers\n +"; my @threes; for (@threedigit){ $_ !~ m/(\d)\d*\1/g and push @threes,$_; } @threedigit = @threes; @threes = (); print "There are ".scalar @threedigit." three digit ones which lack ma +tching digits.\n"; my @fives; for (@fivedigit){ $_ =~ m/^\d*(\d)\1$/ and $_ !~ m/^\d*(\d)\d*\1\d+$/g and push @fives,$_;} @fivedigit = @fives; @fives = (); print "There are ".scalar @fivedigit." five digit ones matching the pa +ttern 'THREE'.\n"; my @THREE; my @TEN; # eliminate fives which dont give a TEN for (@fivedigit) { my $t5 = $_; my ($T,$H,$R,$E) = split //,$t5; my $N = "[^$T$H$R$E]"; for (@threedigit) { my $t3 = $_; my @t3 = split //, $t3; if ($t3 =~ m/$T$E$N/){ $N=$t3[2]; push @threes, $t3; push @fives, $t5; } } } # Now Brute Force my $size = $#fives; my %solution = ('THREE'=>[],'TEN'=>[],'ONE'=>[],'SIX'=>[]); my $idx; for $idx (0..$size) { my ($T,$H,$R,$E) = split //, $fives[$idx]; my ($XT,$XE,$N) = split //, $threes[$idx]; my $cc = "[^$T$H$R$E$N]"; for (@threedigit){ my $num = $_; if ($num =~ m/$cc$N$E/){ my $O = (split //, $num)[0]; my $cc="[^$T$H$R$E$N$O]"; for (@threedigit){ if ($_ =~ /$cc{3}/){ my ($S,$I,$X) = split //, $_; push @{$solution{'THREE'}}, $fives[$idx]; push @{$solution{'TEN'}}, $threes[$idx]; push @{$solution{'ONE'}}, $num; push @{$solution{'SIX'}}, $_; } } } } } # write out solution and timings for (keys %solution) { print "$_:\t",join("\t",@{$solution{$_}}),"\n"; } my @tim = times(); print "Elapsed time:\t",join "\t", @tim,"\n";

    After Compline

Re: (Efficiency Golf) Triangular numbers
by tachyon (Chancellor) on May 31, 2001 at 14:51 UTC

    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.


    #!/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";

    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!

      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; }

      Of course, that's much clearer, and more efficiently, written as:

      @other = grep {some_condition} @array;

      -- Abigail

      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

      Update: Rereading your statement, I saw I'd filtered that too :-) I used $_ !~ m/(\d)\d*\1/g to filter out matching digits.

Re: (Efficiency Golf) Triangular numbers
by blakem (Monsignor) on May 31, 2001 at 10:30 UTC
    This was a fun one. My solution looks quite similiar to Abigail's in structure, but is not nearly so elegant.

    I question how they are really going to judge these based on execution time. Its basically a "find the needle in a haystack" problem, but after you've found it, its pretty easy to write a program that finds it faster the next time around.

    For instance: Which one of these wins? Are any thrown out for "cheating"?

    1: Brute force, try every concievable set of four numbers (loooong time)

    2: Using some sort of filtering at each stage, so not every set of four is used (much quicker)

    3: Cleverly ordering the stages, so they are done in an optimum order -- perhaps 'THREE->TEN->ONE->SIX'. (slightly quicker, though is uses information gathered in program 2)

    4: Brute force, but coded so that the first set of four you try is the correct answer. (even faster!!!)

    5: print "$answer"; (clearly the fastest)

    Since there is only one haystack and one needle, how do you determine which program "finds" it, and which has already been told where it is....


      Thanks for the efficiency clarification... (i.e. only counts here, not for the magazine prize) I was about to add some "pre-sorting" to my arrays, allowing the answer to magically be the first one I tried.


      'Cleverly' ordering the stages is the approcah I used. See the code I have just posted


Re: (Efficiency Golf) Triangular numbers
by blakem (Monsignor) on May 31, 2001 at 22:30 UTC
    Since others are posting, here is my original code. It uses a slightly different tactic, which I hoped would be a bit of an optimization (though I don't think it actually was) When I generate my triangular numbers, I also calculate a "pattern mask", i.e.

    THREE => 'abcdd'
    55345 => 'aabca'
    66456 => 'aabca'
    98766 => 'abcdd' (aha, same as THREE's)
    So: wordmask('THREE') eq wordmask(98766);

    This was supposed to eliminate running repeated regexes against the same numbers. Anyway, it complicates the code a bit and others have submitted faster solutions using the same basic algorithm. Anyway here is the code:

    #!/usr/bin/perl use strict; # Calculate some "masks" outside the loops my (%nummasks,%wordmasks); map{my $k=.5*$_*($_+1); $nummasks{$k}=wordmask($k)}1..446; # ok, this +line was tweaked from another poster map{$wordmasks{$_}=wordmask($_)}('ONE','THREE','SIX','TEN'); # Loop through the THREE candidates for my $three (keys %nummasks) { next unless $nummasks{$three} eq $wordmasks{'THREE'}; my @three = split(//,$three); # Loop through the TEN candidates for my $ten (keys %nummasks) { next unless $nummasks{$ten} eq $wordmasks{'TEN'}; my @ten = split(//,$ten); next unless $ten[0] == $three[0] && $ten[1] == $three[3]; my %used = map{$_,1} (@three); next if $used{$ten[2]}; # Loop through the ONE candidates for my $one (keys %nummasks) { next unless $nummasks{$one} eq $wordmasks{'ONE'}; my @one = split(//,$one); next unless $one[1] == $ten[2] && $one[2] == $ten[1]; my %used = map{$_,1} (@three,@ten); next if $used{$one[0]}; # Find a SIX and we've solved it for my $six (keys %nummasks) { next unless $nummasks{$six} eq $wordmasks{'SIX'}; my @six = split(//,$six); my %used = map{$_,1} (@three,@ten,@one); next if $used{$six[0]} || $used{$six[1]} || $used{$six[2]}; print "ONE:\t$one\nTHREE:\t$three\nSIX:\t$six\nTEN:\t$ten\n"; } } } } sub wordmask { # generate a "pattern mask", 56675 => abbca my $mask = shift; my $letter = 'a'; while ($mask =~ /([^a-z])/) { $mask =~ s/$1/$letter/g; $letter++; } return $mask; }
    $ time ./
    ONE = 435; THREE = 17955; SIX = 820; TEN = 153.
    0.06user 0.00system 0:00.07elapsed 83%CPU

    $ time ./
    ONE: 435 THREE: 17955 SIX: 820 TEN: 153
    0.25user 0.01system 0:00.26elapsed 98%CPU

    So, Abigail's beats mine by a factor of about 4.5!


Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlmeditation [id://84175]
Approved by root
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others lurking in the Monastery: (4)
As of 2023-12-05 05:30 GMT
Find Nodes?
    Voting Booth?
    What's your preferred 'use VERSION' for new CPAN modules in 2023?

    Results (25 votes). Check out past polls.