Your conclusion is good, but your reasoning is not. For instance 8 is a number which is not a perfect square yet has a repeated factor.

A correct way of reasoning this goes as follows:

1. The number of times the n'th light is pulled is the same as its number of factors.
2. It will be on if and only if there are an odd number of factors.
3. If you write out the prime factorization of a number, P₁^n₁ * P₂^n₂ * ... * P_m^n_m, then the number of factors the number has is (i₁ + 1)(i₂ + 1)...(i_m + 1)
4. This is odd if only if i₁, i₂, ... , i_m are all even.
5. This is true if and only if n is a perfect square.
6. From 2) and 5), the n'th light is on if and only if n is a perfect square.

The term "factor" for a non-mathematician (which was my intended audience) is "any number that you multiply by a single other number to get the original number". In the case of 8, 2 is a repeated factor mathematically, but the factors of 8 (according to the gradeschool definition) are 1, 2, 4, and 8 - 4 factors without repetition.

---

My criteria for good software:

1. Does it work?
2. Can someone else come in, make a change, and be reasonably certain no bugs were introduced?

use strict; use warnings;

my %lights = map { $_ => 1 } ( 1..20_000 );

foreach my $flipper ( 2..20_000) {
    for( my $i = $flipper; $i <= 20_000; $i += $flipper ){
        $lights{ $i } = !$lights{ $i };
    }
}

# print 'em
print join(', ', grep { defined $_ }
                 map { $lights{ $_ } ? $_ : undef } 
                     ( 1..20_000)
      )."\n";
[download]

I'm just curious ... why are you using a hash? Hashes are great for string-based indexes or for sparse arrays. But here we have a contiguous array from 1 to 20,000. An array would not only be smaller, but faster. Lots faster. Even with your hash, we could get a bit more out of looping less. In your print, I'm not sure why you grep from the map. You could easily combine them as:

print join(', ', map { $lights{ $_ } ? $_ : () } 
                     ( 1..20_000)
      )."\n";
[download]

Even that is sub-optimal. After all, you want the original number - so you could just grep it out. I've put it as duckyd2 in my benchmark. And, for good measure, I've also added tanktalus as just the rewrite to use arrays.

#!/usr/bin/perl
use strict;
use warnings;

use Benchmark qw(cmpthese);

my $duckyd_answer;

sub duckyd {
    my %lights = map { $_ => 1 } ( 1..20_000 );

    foreach my $flipper ( 2..20_000) {
        for( my $i = $flipper; $i <= 20_000; $i += $flipper ){
            $lights{ $i } = !$lights{ $i };
        }
    }

    $duckyd_answer = join(', ', grep { defined $_ }
                          map { $lights{ $_ } ? $_ : undef }
                          ( 1..20_000)
                         );
}

my $duckyd2_answer;

sub duckyd2 {
    my %lights = map { $_ => 1 } ( 1..20_000 );

    foreach my $flipper ( 2..20_000) {
        for( my $i = $flipper; $i <= 20_000; $i += $flipper ){
            $lights{ $i } = !$lights{ $i };
        }
    }

    $duckyd2_answer = join(', ', grep { $lights{ $_ } }
                           ( 1..20_000)
                          );
}

my $tanktalus_answer;

sub tanktalus {
    my @lights = (1) x 20_000;

    foreach my $flipper ( 2..20_000) {
        for( my $i = $flipper; $i <= 20_000; $i += $flipper ){
            $lights[$i-1] = !$lights[$i-1];
        }
    }

    $tanktalus_answer = join(', ', grep { $lights[$_-1] } 1..20_000);
}

cmpthese(-1,
         {
             duckyd    => \&duckyd,
             duckyd2   => \&duckyd2,
             tanktalus => \&tanktalus,
         },
        );

print "duckyd   answer: $duckyd_answer\n";
print "duckyd2  answer: $duckyd2_answer\n";
print "tankalus answer: $tanktalus_answer\n";
[download]

And the results on this machine:

            Rate    duckyd   duckyd2 tanktalus
duckyd    47.3/s        --       -1%      -44%
duckyd2   47.7/s        1%        --      -44%
tanktalus 84.6/s       79%       77%        --
[download]

(I've removed the answers as they're all the same.) The 1% speed benefit of duckyd2 over duckyd is purely the removal of the map in the output string - mostly ignorable, I grant, as it's still O(n) vs the O(n^2) algorithm right before it. As you can see, arrays are significantly faster than hashes for this. Still O(n^2), but the constant is reduced ;-)

You can save more time and space by using a string of '1's & '0's, and a bit more still using a bitstring.

sub buk1 {
    my $lights = '1' x ( 20_000 );

    for my $gap ( 2 .. 20_000 ) {
        for( my $o = $gap; $o <= 20_000; $o += $gap ) {
            substr($lights, $o, 1) = substr($lights, $o, 1) eq '0' ? '
+1' : '0';
        }
    }

    $answers{ buk1 } = join ', ', grep{ substr( $lights, $_, 1 ) } 1 .
+. 20_000;
}

sub buk2 {
    my $lights = "\xFF" x ( 20_001 / 8 );

    for my $gap ( 2 .. 20_000 ) {
        for( my $o = $gap; $o < 20_000; $o += $gap ) {
            vec( $lights, $o, 1 ) = ~vec( $lights, $o, 1 );
        }
    }

    $answers{ buk2 } = join ', ', grep{ vec( $lights, $_, 1 ) } 1 .. 2
+0_000;
}

P:\test>junk
            Rate   duckyd2    duckyd tanktalus       buk      buk2
duckyd2   1.96/s        --       -1%      -53%      -66%      -69%
duckyd    1.99/s        1%        --      -53%      -66%      -68%
tanktalus 4.20/s      114%      111%        --      -28%      -33%
buk       5.82/s      197%      193%       39%        --       -7%
buk2      6.27/s      220%      215%       49%        8%        --
Comparing buk1 and buk2
Comparing buk2 and duckyd
Comparing duckyd and duckyd2
Comparing duckyd2 and tanktalus
[download]

---

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?

"Science is about questioning the status quo. Questioning authority".

In the absence of evidence, opinion is indistinguishable from prejudice.

The only reason that I used a hash was that it was more fun to print the results with a hash than an array. My solution was not meant to be the most efficient, as it obviously wouldn't scale well at all.

The trouble with enumerating the result - what if it had been 2,000,000,000,000,000,000,000 instead of 20,000?

2,000,000,000,000,000,000,000 == 2 * 10²¹ == 5 * 4 * 10²⁰ == 5 * (2 * 10¹⁰)².

So, all you need to do is list the squares of all numbers from 1 to sqrt(5) * 2 * 10¹⁰. It'll take a while to list, but you can do it with a one-liner.

Perl --((8:>*

I think the OP was saying "what if the original solutions posted in this thread were used for <insert really large number here> bulbs?". The solutions posted near the top of the thread relied on walking the list numerous times, which is infeasible if the list is super large. The elegance in finding the mathematical property for the bulbs being on is that it does scale.

thor

Feel the white light, the light within
Be your own disciple, fan the sparks of will
For all of us waiting, your kingdom will come

Those were all quick questions that came to my mind. I was a little slower to question if these cords were attached to switches or plugged into power outlets.

Be well,
rir

The lack of clarity that you mention is noted. The audio portion of the show provided some context that isn't presented in the text version of the puzzle that I quoted directly from CarTalk website.

cheers

Fred

-------------------------------------
Nothing is too wonderful to be true
-- Michael Faraday

As a demonstration of how finding the pattern (perfect squares) is so much better than brute force, a benchmark:

use strict;
use warnings;
$|=1;

sub sol1 {
    #init;
    my $lights = 20_000;
    my @lit = map {1} (1..$lights);
    
    my @sol;
    
    #flip;
    for (2..$lights) { 
        my $cnt = $_-1;
        while ($cnt < $lights) { 
            $lit[$cnt] = !$lit[$cnt];
            $cnt+=$_;
        }
    }
    
    #answer;
    for (0..$#lit) { push @sol, $_+1 if $lit[$_] }
}

sub sol2 {
    my $lights = 20_000;
    
    my @sol;
    
    for (1..$lights) {
        my $sqr = sqrt($_);
        push @sol, $_ if int($sqr) == $sqr;
    }
}

use Benchmark ':all';
cmpthese( 100, {
    sol1 => \&sol1,
    sol2 => \&sol2,
});

__END__
       Rate  sol1  sol2
sol1 6.58/s    --  -93%
sol2 98.5/s 1398%    --
[download]

These two solutions are abstracted to work for any number of lights, and the first is meant to be something someone of average coding skill might come up with (i.e. my crack at the solution ;-) ). Notice how sol2, where we just find all the perfect squares in range, is tremendously faster.

Just goes to show that the best optimization is done by redefining the problem. In this case, redefining from "toggle every nth light for n=2..max" to "find all lights that are perfect squares" resulted in a performance gain of nearly 1700%1400%!

Updates:

• 2005-11-17 : corrected use of 'our' to 'my', thanks to Perl Mouse. I don't know why I used our, it must be related to my lack of caffeine today.

That's not a very good benchmark, as you will be pushing the answer onto the same array over and over again. After running your benchmark, @main::sol contains 28200 elements.

I don't understand why you are using our all over your program. What's wrong with my?

But you missed a much faster solution: just taking the squares of the numbers from 1 to the square root of 20_000.

Here's a revised benchmark:

use strict;
use warnings;

my (@sol1, @sol2, @sol3);
my $lights = 20_000;

sub sol1 {
        #init;
        my @lit = (1) x ($lights+1);
        
        #flip;
        for (2..($lights+1)) {
                my $cnt = $_;
                while ($cnt <= $lights) {
                        $lit[$cnt] = !$lit[$cnt];
                        $cnt+=$_;
                }
        }
 
        #answer;
        @sol1 = grep {$lit[$_]} 1 .. ($lights+1);
}
 
sub sol2 {
        @sol2 = ();
        for (1..$lights) {
                my $sqr = sqrt($_);
                push @sol2, $_ if int($sqr) == $sqr;
        }
}
 
sub sol3 {
        @sol3 = map {$_**2} 1 .. sqrt($lights);
}


use Benchmark ':all';
cmpthese( -10, {
        sol1 => \&sol1,
        sol2 => \&sol2,
        sol3 => \&sol3,
});     

__END__
       Rate   sol1   sol2   sol3
sol1 3.92/s     --   -90%  -100%
sol2 41.0/s   945%     --   -99%
sol3 3762/s 95923%  9085%     --
[download]

Perl --((8:>*

Yeah, I don't know why I used our. Not enough coffee today, I guess -- it's not even a general habit of mine. Odd. Thanks, though.

Thanks also for your even-faster solution, which reinforces my core point: understanding the problem well enough to rephrase it leads to much faster results!

<-radiant.matrix->
A collection of thoughts and links from the minds of geeks
The Code that can be seen is not the true Code
"In any sufficiently large group of people, most are idiots" - Kaa's Law

I am actually only mainly posting this because I was puzzled that the this line of code didn't work: $lights{$light} ? $lights{$light} = 0 : $lights{$light} = 1; # turn off if it's on, and vice versa. Ternary if operator didn't work, and I had to do this with normal if operator. If I get around to it I wanted to ask a SOPW about this later on today...

The Hall of 20,000 Ceiling Lights

There are 20,000 lights on. A person comes through and pulls the cord on every second light. A third person comes along and pulls the cord on every third light, etc. When someone comes who pulls every 20,000th chain, which lights are on?

I mean, I'm all for trying to solve things programmatically, but do we need a program for this?

That confused me too. After reading the responses, I figured out that the puzzle refers to the cord – not plug – that switches a light on and off. So if a light has its cord pulled once, it’s off, twice, it’s on again, thrice, off again, etc. So the guy who pulls every 3rd cord will switch the 6th light back on, as well as the 12th, the 18th, etc. (In fact, he turns one light back on for each light that he turns off.)

Hope that clears the confusion.

(And that you weren’t jesting.)

Makeshifts last the longest.

Well, consider that light number 4 is originally on, then gets turned off since it is a multiple of 2, then gets turned on since it is a multiple of 4, and then that's it for number 4.

 print sqrt==int(sqrt)?1:0for(1..2e4);
[download]

print sqrt==int(sqrt)?1:0for 1..2e4;
[download]

:-)

You got away with it because perl is looking for an expression; when the thing it then sees starts with a digit, it can't be anything but a literal number. So the parser eats as many characters as can be part of a literal number and then stops. For some fun, insert an x right after the 0 and watch what happens; or try any number of underscores.

Makeshifts last the longest.

Adding underscore doesn't add much fun. Adding an 'x' does:

$ perl -le 'print 0for 1, 2, 3'
0
0
0
$ perl -le 'print 0_for 1, 2, 3'
0
0
0
$ perl -le 'print 0xfor 1, 2, 3'
15
[download]

Perl --((8:>*

print 0+sqrt!~/\./for 1..2e4
[download]

As a slight drift, how did I manage to get away without a space before the 'for'?

Because you only need spaces if the concatenation of the two tokens creates a longer leading token. But in Perl, no token starts with '0f', hence perl knows '0' is a token, and 'for' another.
Perl --((8:>*

  

print 0+sqrt!~/\./for 1..2e4

very cool lateral thinking.

cheers for the replies re the space thing. I never really give any thought to the parser. How do you pick this stuff up without delving into the internals? (which I don't think I'm ready for)

---
my name's not Keith, and I'm not reasonable.