Home > Archive > PERL Miscellaneous > June 2005 > Fibonacci string
You are viewing an archived Text-only version of the thread.
To view this thread in it's original format and/or if you want to reply to
this thread please [click here]
|
|
| David K. Wall 2005-05-24, 8:56 pm |
| Here's a fun fact I ran across in the book _The Golden Ratio_, by
Mario Livio. Take the string '1' and replace it with '10'.
Thereafter, replace any occurrence of '1' with '10' and '0' with '1'.
Then count the number of 0s and 1s in the string. You get a
Fibonacci sequence for each count (offset by one iteration).
Here's Perl code to do it. You get about the same results if you
start with '0', just offset a little.
use strict;
use warnings;
my $v = '1';
for (1 .. 20) {
my ($n0, $n1) = (0, 0);
$v = join '',
map {
if ($_) {
$n1++;
'10';
}
else {
$n0++;
'1';
}
} split //, $v;
printf "%10d %10d\n", $n0, $n1;
}
--
David Wall
| |
| ioneabu@yahoo.com 2005-05-24, 8:56 pm |
|
David K. Wall wrote:
> Here's a fun fact I ran across in the book _The Golden Ratio_, by
> Mario Livio. Take the string '1' and replace it with '10'.
> Thereafter, replace any occurrence of '1' with '10' and '0' with '1'.
> Then count the number of 0s and 1s in the string. You get a
> Fibonacci sequence for each count (offset by one iteration).
>
> Here's Perl code to do it. You get about the same results if you
> start with '0', just offset a little.
>
> use strict;
> use warnings;
>
> my $v = '1';
> for (1 .. 20) {
> my ($n0, $n1) = (0, 0);
> $v = join '',
> map {
> if ($_) {
> $n1++;
> '10';
> }
> else {
> $n0++;
> '1';
> }
> } split //, $v;
> printf "%10d %10d\n", $n0, $n1;
> }
>
>
> --
> David Wall
Very  . Thanks!
wana
| |
| John W. Krahn 2005-05-24, 8:56 pm |
| David K. Wall wrote:
> Here's a fun fact I ran across in the book _The Golden Ratio_, by
> Mario Livio. Take the string '1' and replace it with '10'.
> Thereafter, replace any occurrence of '1' with '10' and '0' with '1'.
> Then count the number of 0s and 1s in the string. You get a
> Fibonacci sequence for each count (offset by one iteration).
>
> Here's Perl code to do it. You get about the same results if you
> start with '0', just offset a little.
>
> use strict;
> use warnings;
>
> my $v = '1';
> for (1 .. 20) {
> my ($n0, $n1) = (0, 0);
> $v = join '',
> map {
> if ($_) {
> $n1++;
> '10';
> }
> else {
> $n0++;
> '1';
> }
> } split //, $v;
> printf "%10d %10d\n", $n0, $n1;
> }
You can make that shorter and faster:
my $v = '1';
for ( 1 .. 20 ) {
printf "%10d %10d\n", $v =~ y/0//, $v =~ y/1//;
$v =~ s/([01])/ $1 ? '10' : '1' /eg;
}
:-)
John
--
use Perl;
program
fulfillment
| |
| Darren Dunham 2005-05-24, 8:56 pm |
| David K. Wall <darkon.tdo@gmail.com> wrote:
> use strict;
> use warnings;
> my $v = '1';
> for (1 .. 20) {
> my ($n0, $n1) = (0, 0);
> $v = join '',
> map {
> if ($_) {
> $n1++;
> '10';
> }
> else {
> $n0++;
> '1';
> }
> } split //, $v;
> printf "%10d %10d\n", $n0, $n1;
> }
Very nice...
I might do it this way and let the regex engine do some of the heavy
lifting.. :-)
use strict;
use warnings;
$_=0;
foreach my $loop ( 1 .. 20 )
{
s/(.)/$1?10:1/eg;
my $ones = tr/1//;
printf "%10d %10d\n", length() - $ones, $ones;
}
--
Darren Dunham ddunham@taos.com
Senior Technical Consultant TAOS http://www.taos.com/
Got some Dr Pepper? San Francisco, CA bay area
< This line left intentionally blank to confuse you. >
| |
| unixSPAM@zeouane.org 2005-05-24, 8:56 pm |
| John W. Krahn <someone@example.com> wrote:
>
> You can make that shorter and faster:
>
>
> my $v = '1';
> for ( 1 .. 20 ) {
> printf "%10d %10d\n", $v =~ y/0//, $v =~ y/1//;
> $v =~ s/([01])/ $1 ? '10' : '1' /eg;
> }
We're not worthy !!
--
unix@zeouane.org
| |
| John W. Krahn 2005-05-24, 8:56 pm |
| John W. Krahn wrote:
> David K. Wall wrote:
>
>
> You can make that shorter and faster:
>
> my $v = '1';
> for ( 1 .. 20 ) {
> printf "%10d %10d\n", $v =~ y/0//, $v =~ y/1//;
> $v =~ s/([01])/ $1 ? '10' : '1' /eg;
> }
A bit faster. :-)
my $v = '1';
for ( 1 .. 20 ) {
printf "%10d %10d\n", $v =~ y/0//, $v =~ y/1//;
$v =~ s/./ $& ? '10' : '1' /eg;
}
John
--
use Perl;
program
fulfillment
| |
| Anno Siegel 2005-05-25, 8:56 am |
| david k. wall <darkon.tdo@gmail.com> wrote in comp.lang.perl.misc:
> here's a fun fact i ran across in the book _the golden ratio_, by
> mario livio. take the string '1' and replace it with '10'.
> thereafter, replace any occurrence of '1' with '10' and '0' with '1'.
> then count the number of 0s and 1s in the string. you get a
> fibonacci sequence for each count (offset by one iteration).
Well, lessee...
If string v has n0 zeroes and n1 ones, substituting all ones with
'10' gives n1 ones and n1 zeroes. Substituting zeroes with '1' adds
another n0 ones (and no zeroes). So the number n0' of zeroes in the
next string is n1, and the number n1' of ones is n0 + n1.
If (n0, n1) are subsequent Fibonacci numbers, then (n0', n1') =
(n1, n0 + n1) are the next two Fibonacci numbers. Since this is true
for the very first string '1', with 0 = fib[ 0] zeroes and 1 = fib[ 1]
ones, it is true for all strings thus generated.
The observation that it doesn't matter where the zeroes and ones
appear in the strings leads to a solution that doesn't use s///:
my $v = '1';
for ( 1 .. 20 ) {
my $n0 = $v =~ tr/0/1/;
printf "%10d %10d\n", $n0, length( $v) - $n0;
$v .= '0' x ( length( $v) - $n0);
}
I generates a different sequence of strings $v (less fancy patterns),
but with the same distribution of ones and zeroes. If you prefer
to call it "cheating" I won't object.
Anno
| |
| Josef Moellers 2005-05-25, 8:56 am |
| Anno Siegel wrote:
> david k. wall <darkon.tdo@gmail.com> wrote in comp.lang.perl.misc:
>=20
[color=darkred]
>=20
>=20
> Well, lessee...
>=20
> If string v has n0 zeroes and n1 ones, substituting all ones with
> '10' gives n1 ones and n1 zeroes. Substituting zeroes with '1' adds
> another n0 ones (and no zeroes). So the number n0' of zeroes in the
> next string is n1, and the number n1' of ones is n0 + n1.
>=20
> If (n0, n1) are subsequent Fibonacci numbers, then (n0', n1') =3D
> (n1, n0 + n1) are the next two Fibonacci numbers. Since this is true
> for the very first string '1', with 0 =3D fib[ 0] zeroes and 1 =3D fib[=
1]
> ones, it is true for all strings thus generated.
Not bad. Very nice to see that there are still people around who can=20
_prove_ that an algorithm does what it is supposed to do rather than=20
deduce from a small set of results that all results follow a pattern.
Congratulations!
> The observation that it doesn't matter where the zeroes and ones
> appear in the strings leads to a solution that doesn't use s///:
>=20
> my $v =3D '1';
> for ( 1 .. 20 ) {
> my $n0 =3D $v =3D~ tr/0/1/;
> printf "%10d %10d\n", $n0, length( $v) - $n0;
> $v .=3D '0' x ( length( $v) - $n0);
> }
>=20
> I generates a different sequence of strings $v (less fancy patterns),
> but with the same distribution of ones and zeroes. If you prefer
> to call it "cheating" I won't object.
No, I'd call this professionalism.
I wish I'd be as thorough as you.
I bow my head,
Josef
--=20
Josef M=F6llers (Pinguinpfleger bei FSC)
If failure had no penalty success would not be a prize
-- T. Pratchett
| |
| David K. Wall 2005-05-25, 3:56 pm |
| John W. Krahn <someone@example.com> wrote:
> John W. Krahn wrote:
>
> A bit faster. :-)
>
> my $v = '1';
> for ( 1 .. 20 ) {
> printf "%10d %10d\n", $v =~ y/0//, $v =~ y/1//;
> $v =~ s/./ $& ? '10' : '1' /eg;
>}
I bow to greater perl-fu, but with the caveat that I was more
interested in making the idea clear than in coming up with a fast
implementation. I'd accuse you of having too much time on your hands
if I weren't guilty of the same sort of thing myself.
| |
| Anno Siegel 2005-05-25, 3:56 pm |
| Josef Moellers <josef.moellers@fujitsu-siemens.com> wrote in comp.lang.perl.misc:
> Anno Siegel wrote:
[...]
[color=darkred]
>
> No, I'd call this professionalism.
Well, it's only a step away from generating the fibonacci numbers the
way they are defined and creating $v on the side:
my( $n0, $n1) = ( 0, 1);
for ( 1 .. 20 ) {
my $v = '1' x $n1 . '0' x $n0;
printf "%10d %10d\n", $n0, $n1;
( $n0, $n1) = ( $n1, $n0 + $n1);
}
That generates the same sequence $v as above, and it *would* be cheating.
It *is* dramatically faster (either way) than the s///-solutions we've seen.
These strings get large fast, and s/// does a lot of tail-copying for
all the size-changing replacements.
BTW, I have no idea how this subthread lost connection to the main thread
on the subject, at least for my newsreader.
Anno
| |
| David K. Wall 2005-05-25, 3:56 pm |
| Josef Moellers <josef.moellers@fujitsu-siemens.com> wrote:
> Anno Siegel wrote:
>
>
> No, I'd call this professionalism.
> I wish I'd be as thorough as you.
>
> I bow my head,
Agreed. I just wanted to generate it so I could look at the pattern
for longer strings than the book contained.
The original string does have some interesting properties that do
depend on the order of the ones and zeroes. Some of them are
described at this URL:
http://www.mcs.surrey.ac.uk/Persona...cci/fibrab.html
The book I was reading mentions a few others.
Sorry, this is getting a bit removed from Perl.
| |
| Anno Siegel 2005-05-25, 8:56 pm |
| David K. Wall <darkon.tdo@gmail.com> wrote in comp.lang.perl.misc:
> Josef Moellers <josef.moellers@fujitsu-siemens.com> wrote:
>
>
> Agreed. I just wanted to generate it so I could look at the pattern
> for longer strings than the book contained.
>
> The original string does have some interesting properties that do
> depend on the order of the ones and zeroes. Some of them are
> described at this URL:
> http://www.mcs.surrey.ac.uk/Persona...cci/fibrab.html
> The book I was reading mentions a few others.
>
> Sorry, this is getting a bit removed from Perl.
Yes, but in an interesting way. I'll stick with it for one more remark.
The sequence of $v, as defined by the substitution rule, can also
be generated by concatenating strings that have already be generated.
The rule is exactly that for generation of fibonacci numbers, with
addition replaced by concatenation. In particular (code untested,
but the algorithm is):
my ( $prev, $v) = qw( 0 1);
for ( 1 .. 20 ) {
printf "%10d %10d\n", $v =~ y/0//, $v =~ y/1//;
( $prev, $v) = ( $v, $v . $prev);
}
I bet that's one of the interesting properties mentioned on the web site.
(or the book). I haven't proved any of this, just observed it, but an
inductive proof seems entirely feasible. It should create the original
sequence at the speed of the "cheating" solutions shown above.
Anno
| |
| Abigail 2005-05-26, 3:57 am |
| John W. Krahn (someone@example.com) wrote on MMMMCCLXXXIV September
MCMXCIII in <URL:news:GsOke.9458$9A2.8141@edtnps89>:
##
## A bit faster. :-)
##
## my $v = '1';
## for ( 1 .. 20 ) {
## printf "%10d %10d\n", $v =~ y/0//, $v =~ y/1//;
## $v =~ s/./ $& ? '10' : '1' /eg;
## }
Much faster:
my $v = '1';
for ( 1 .. 20 ) {
printf "%10d %10d\n", $v =~ y/0//, $v =~ y/1//;
$v =~ s/1/12/g; $v =~ y/02/10/;
}
Benchmark:
#!/usr/bin/perl
use strict;
use warnings;
no warnings qw /syntax/;
use Benchmark qw 'cmpthese';
our @a = (1, 10);
our ($j, $a);
our $max = 20;
cmpthese -5 => {
john => '$j = 1; for (1 .. $max) {$j =~ s/./$& ? "10" : "1"/eg;}',
abigail => '$a = 1; for (1 .. $max) {$a =~ s/1/12/g; $a =~ y/02/10/}',
};
die unless $a eq $j;
__END__
Rate john abigail
john 21.3/s -- -62%
abigail 55.4/s 160% --
Abigail
--
perl -we 'eval {die ["Just another Perl Hacker\n"]}; print ${${@}}[$#{@{${@}}}]'
| |
| John W. Krahn 2005-05-26, 8:56 am |
| Abigail wrote:
> John W. Krahn (someone@example.com) wrote on MMMMCCLXXXIV September
> MCMXCIII in <URL:news:GsOke.9458$9A2.8141@edtnps89>:
> ##
> ## A bit faster. :-)
> ##
> ## my $v = '1';
> ## for ( 1 .. 20 ) {
> ## printf "%10d %10d\n", $v =~ y/0//, $v =~ y/1//;
> ## $v =~ s/./ $& ? '10' : '1' /eg;
> ## }
>
> Much faster:
>
> my $v = '1';
> for ( 1 .. 20 ) {
> printf "%10d %10d\n", $v =~ y/0//, $v =~ y/1//;
> $v =~ s/1/12/g; $v =~ y/02/10/;
> }
>
> Benchmark:
>
> #!/usr/bin/perl
>
> use strict;
> use warnings;
> no warnings qw /syntax/;
>
> use Benchmark qw 'cmpthese';
>
> our @a = (1, 10);
> our ($j, $a);
> our $max = 20;
>
> cmpthese -5 => {
> john => '$j = 1; for (1 .. $max) {$j =~ s/./$& ? "10" : "1"/eg;}',
> abigail => '$a = 1; for (1 .. $max) {$a =~ s/1/12/g; $a =~ y/02/10/}',
> };
>
> die unless $a eq $j;
>
> __END__
> Rate john abigail
> john 21.3/s -- -62%
> abigail 55.4/s 160% --
Thanks Abigail,
I wonder if Ton can come up with a Perl program that does the same thing
in ~50 characters? :-)
John
--
use Perl;
program
fulfillment
| |
| Anno Siegel 2005-05-26, 8:56 am |
| Abigail <abigail@abigail.nl> wrote in comp.lang.perl.misc:
> John W. Krahn (someone@example.com) wrote on MMMMCCLXXXIV September
> MCMXCIII in <URL:news:GsOke.9458$9A2.8141@edtnps89>:
> ##
> ## A bit faster. :-)
> ##
> ## my $v = '1';
> ## for ( 1 .. 20 ) {
> ## printf "%10d %10d\n", $v =~ y/0//, $v =~ y/1//;
> ## $v =~ s/./ $& ? '10' : '1' /eg;
> ## }
>
>
> Much faster:
>
> my $v = '1';
> for ( 1 .. 20 ) {
> printf "%10d %10d\n", $v =~ y/0//, $v =~ y/1//;
> $v =~ s/1/12/g; $v =~ y/02/10/;
> }
Avoiding s/// altogether gains another factor of 50 or so:
my $v = 1;
for ( 1 .. 20 ) {
printf "%10d %10d\n", $v =~ y/0//, $v =~ y/1//;
$_ .= length > 1 ? substr( $_, 0, tr/1/1/) : 0 for $v;
}
Benchmark:
#!/usr/bin/perl
use strict; use warnings; $| = 1; # @^~`
use Vi::QuickFix;
use Benchmark qw 'cmpthese';
our ($j, $a, $b);
our $max = 20;
cmpthese -5 => {
john => '$j = 1; for (1 .. $max) {$j =~ s/./$& ? "10" : "1"/eg;}',
abigail => '$a = 1; for (1 .. $max) {$a =~ s/1/12/g; $a =~ y/02/10/}',
anno => '$b = 1; for (1 .. $max) ' .
'{ $_ .= length() > 1 ? substr( $_, 0, y/1/1/) : 0 for $b}',
};
die unless $a eq $j and $b eq $j;
__END__
Anno
| |
| Ilmari Karonen 2005-06-08, 3:59 pm |
| Anno Siegel <anno4000@lublin.zrz.tu-berlin.de> kirjoitti 26.05.2005:
>
> Avoiding s/// altogether gains another factor of 50 or so:
>
> my $v = 1;
> for ( 1 .. 20 ) {
> printf "%10d %10d\n", $v =~ y/0//, $v =~ y/1//;
> $_ .= length > 1 ? substr( $_, 0, tr/1/1/) : 0 for $v;
> }
If we're allowed to change the algorithm as long as the same strings
are produced, I think I can do even better:
my $v = 1; my $v2 = 0;
for ( 1 .. 20 ) {
printf "%10d %10d\n", $v =~ y/0//, $v =~ y/1//;
my $t = $v; $v .= $v2; $v2 = $t;
}
Benchmark:
#!/usr/bin/perl
use strict;
use warnings;
use Benchmark qw 'cmpthese';
our ($j, $a, $b, $c);
our $max = 10;
cmpthese -3 => {
john => '$j = 1; for (1 .. $max) {$j =~ s/./$& ? "10" : "1"/eg}',
abigail => '$a = 1; for (1 .. $max) {$a =~ s/1/12/g; $a =~ y/02/10/}',
anno => '$b = 1; for (1 .. $max) {$_ .= length() > 1 ? substr( $_, 0, y/1/1/) : 0 for $b}',
ilmari => '$c = 1; my $c2 = 0; for (1 .. $max) {my $t = $c; $c .= $c2; $c2 = $t}',
};
die unless $a eq $j and $b eq $j and $c eq $j;
__END__
--
Ilmari Karonen
To reply by e-mail, please replace ".invalid" with ".net" in address.
| |
| Anno Siegel 2005-06-08, 3:59 pm |
| Ilmari Karonen <usenet@vyznev.invalid> wrote in comp.lang.perl.misc:
> Anno Siegel <anno4000@lublin.zrz.tu-berlin.de> kirjoitti 26.05.2005:
>
> If we're allowed to change the algorithm as long as the same strings
> are produced, I think I can do even better:
I think we should *always* consider a change in algorithm when playing
optimization games. It is the most promising approach, if applicable.
This thread has shown it again.
> my $v = 1; my $v2 = 0;
> for ( 1 .. 20 ) {
> printf "%10d %10d\n", $v =~ y/0//, $v =~ y/1//;
> my $t = $v; $v .= $v2; $v2 = $t;
> }
Ah, an append-only solution. Yes, it beats my fastest version
use constant PHI => ( 1 + sqrt(5))/2;
my $c = 1;
for (1 .. 20) {
$c .= length( $c) > 1 ? substr( $c, 0, int 0.5 + length()/PHI) : 0;
}
slightly.
Anno
| |
| Anno Siegel 2005-06-08, 3:59 pm |
| Ilmari Karonen <usenet@vyznev.invalid> wrote in comp.lang.perl.misc:
> Anno Siegel <anno4000@lublin.zrz.tu-berlin.de> kirjoitti 26.05.2005:
>
> If we're allowed to change the algorithm as long as the same strings
> are produced, I think I can do even better:
I think we should *always* consider a change in algorithm when playing
optimization games. It is the most promising approach, if applicable.
This thread has shown it again.
> my $v = 1; my $v2 = 0;
> for ( 1 .. 20 ) {
> printf "%10d %10d\n", $v =~ y/0//, $v =~ y/1//;
> my $t = $v; $v .= $v2; $v2 = $t;
> }
Ah, an append-only solution. Yes, it beats my fastest version
use constant PHI => ( 1 + sqrt(5))/2;
my $c = 1;
for (1 .. 20) {
$c .= length( $c) > 1 ? substr( $c, 0, int 0.5 + length( $c)/PHI) : 0;
}
slightly.
Anno
| |
| Tom Bates 2005-06-10, 3:58 pm |
| I think I know perl pretty well, but I have to carefully study most of
these alternatives to see how they work! You guys are amazing!
Tom
|
|
|
|
|