This weeks puzzler from CarTalk
(not a permalink. week 11/17/2005)
inspired me to verify my solution by writing a short Perl script. The puzzle is stated like so:
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?
Can you solve the puzzle? Without a script?
My script looks like so:
use strict;
my $MAX = 20001;
my @bulbs;
$bulbs[$_] = 0 for ( 0..$MAX ); # use 1 and 0 for display purposes
# Try goes thru the integers, Switching the bulbs.
TRY: for my $try ( 1..$MAX ) {
# switch by multiples;
MULTIPLE: for my $i ( 1..$MAX ) {
my $m = $i*$try;
next TRY if ( $m > $MAX );
# a not works nicely here
# if you don't plan to print your array
$bulbs[$m] = $bulbs[$m] == 1 ? 0 : 1;
}
}
print "\n\n";
for my $n ( 1..$MAX ) {
printf "Bulb %5d is ON\n", $n if ( $bulbs[$n] );
}
And the answer is: only bulbs whose numbers are perfect squares are lit. 1,4,9,16...

Nothing is too wonderful to be true
 Michael Faraday
Re: CarTalk Puzzler by duckyd (Hermit) on Nov 17, 2005 at 00:28 UTC 
I love CarTalk. Here's my solution:
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";
 [reply] [d/l] 

I'm just curious ... why are you using a hash? Hashes are great for stringbased 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";
Even that is suboptimal. 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[$i1] = !$lights[$i1];
}
}
$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";
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% 
(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 ;)  [reply] [d/l] [select] 

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
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.
 [reply] [d/l] 

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.
 [reply] 
Re: CarTalk Puzzler by chas (Priest) on Nov 17, 2005 at 03:39 UTC 
I would solve it as follows. Think of each light as initially off. Then the cord is pulled once for each divisor of its
number. But a number of form p_1^{r_1}p_2^{r_2}...p_j^{r_j}
(where the p_i are distinct primes) has (r_11)...(r_j1)
factors; this is easily proved. Now it is clear that the number of factors is odd exactly when the number is a perfect
square (i.e. all the r_i are even.) But pulling the switch an
odd number of times when it is off turns it on. (The problem
states they are all initially on, but think of them as
being off and turned on for the divisor 1.)
The trouble with enumerating the result  what if it had been
2,000,000,000,000,000,000,000 instead of 20,000?
chas
Update Sorry, of course the number of factors is
(r_1+1)...(r_j+1), not (r_11)...(r_j1). I guess I was
brain dead when I first posted. The conclusion is the same,
though; this is odd exactly when all the r_i are even.  [reply] 

 [reply] 

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
 [reply] 
Re: CarTalk Puzzler by dragonchild (Archbishop) on Nov 17, 2005 at 03:45 UTC 
No code is needed. It's about the number of factors. Start with everything off and have someone go through and pull every 1nth cord. Then, someone pulls every 2nd and on with the puzzle. If a number has an even number of factors, then it will be off. If it has an odd number of factors, it will be on. The only numbers that have an odd number of factors is when one of the factors is repeated. That only happens if it's a perfect square. :)
My criteria for good software:
 Does it work?
 Can someone else come in, make a change, and be reasonably certain no bugs were introduced?
 [reply] 

 [reply] 

The term "factor" for a nonmathematician (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:
 Does it work?
 Can someone else come in, make a change, and be reasonably certain no bugs were introduced?
 [reply] 


Re: CarTalk Puzzler by rir (Vicar) on Nov 17, 2005 at 04:29 UTC 
I could not solve your puzzle as stated. I don't know
what the implied second person did. I don't know if pulling the cord on every second light means every
second light fixture or every second light that is on.
Beyond that: If these lights have cords where do the chains come in?
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  [reply] 

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
 [reply] [d/l] 
Re: CarTalk Puzzler by tphyahoo (Vicar) on Nov 17, 2005 at 11:57 UTC 
Okay here is my hideously slow, unoptimized, but obvious code.
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...
 [reply] [d/l] [select] 
Re: CarTalk Puzzler by tbone1 (Monsignor) on Nov 17, 2005 at 13:57 UTC 
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?
Um, only the first light is on; all the others have had their plugs pulled. Obvious, isn't it, or am I missing something?
I mean, I'm all for trying to solve things programmatically, but do we need a program for this?

tbone1, YAPS (Yet Another Perl Schlub)
And remember, if he succeeds, so what.
 Chick McGee
 [reply] 

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.
 [reply] 

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.
 [reply] 
Re: CarTalk Puzzler by Moron (Curate) on Nov 17, 2005 at 14:17 UTC 
Each number is accessed as many times as it has distinct factors including itself. If the total number of such factors is greater than 1, then the number of factors is even because the total permutations of the set of prime factors of a number is 2^N where N is the number of such factors (N is only 0 if there are no such factors which only occurs for 1), creating at first sight a general rule for turning all lights off except the first one. But there are exceptions to that rule occurring where the difference between the raw number of permutations and the number of elements of the uniquified version of that set is odd (because repeating factors only actually access the light once). And that only occurs where the unique factorisation into primes contains an even number of occurrences of each prime. The two propositions: "x is a perfect square" and "the unique factorisation of x into primes can be divided into two equal sets" imply each other.
 [reply] 
Re: CarTalk Puzzler by radiantmatrix (Parson) on Nov 17, 2005 at 16:43 UTC 
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% 
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:
 20051117 : 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.
 [reply] [d/l] [select] 

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% 
 [reply] [d/l] 

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 evenfaster solution, which reinforces my core point: understanding the problem well enough to rephrase it leads to much faster results!
 [reply] [d/l] 
Re: CarTalk Puzzler by reasonablekeith (Deacon) on Nov 18, 2005 at 09:45 UTC 
how about some golf? (yes, I know it's cheating :P )
print sqrt==int(sqrt)?1:0for(1..2e4);
BTW: As a slight drift, how did I manage to get away without a space before the 'for'?

my name's not Keith, and I'm not reasonable.
 [reply] [d/l] 

print 0+sqrt!~/\./for 1..2e4
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.
 [reply] [d/l] 

 [reply] 


print sqrt==int(sqrt)?1:0for 1..2e4;
:)
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.  [reply] [d/l] 

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
 [reply] [d/l] 


