P is for Practical PerlMonks

### CarTalk Puzzler

by freddo411 (Chaplain)
 on Nov 16, 2005 at 23:37 UTC ( #509241=perlmeditation: print w/ replies, xml ) Need Help??

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

Replies are listed 'Best First'.
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:
1. Does it work?
2. Can someone else come in, make a change, and be reasonably certain no bugs were introduced?
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, P1n1 * P2n2 * ... * Pmnm, then the number of factors the number has is (i1 + 1)(i2 + 1)...(im + 1)
4. This is odd if only if i1, i2, ... , im 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?
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";

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";
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);

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

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

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

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

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

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.
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_1-1)...(r_j-1) 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_1-1)...(r_j-1). 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.
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 * 1021 == 5 * 4 * 1020 == 5 * (2 * 1010)2.

So, all you need to do is list the squares of all numbers from 1 to sqrt(5) * 2 * 1010. 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

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

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

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+=\$_;
}
}

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%!

• 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.

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
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+=\$_;
}
}

@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%     --
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!

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
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...

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

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.
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.

-M

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.
```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.

```\$ 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
Perl --((8:>*
```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.
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.

Create A New User
Node Status?
node history
Node Type: perlmeditation [id://509241]
Approved by GrandFather
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
As of 2016-07-27 12:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
What is your favorite alternate name for a (specific) keyboard key?

Results (242 votes). Check out past polls.