The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

# Copyright 2010, 2011, 2012, 2013 Kevin Ryde

# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath.  If not, see <http://www.gnu.org/licenses/>.


use 5.004;
use strict;

# uncomment this to run the ### lines
use Smart::Comments;

{
  # Knot overlapping points
  # 0,1,  4,16,68,288,1220,5168
  #    /4 1,4,17,72,305,1292 = A001076 a(n) = 4a(n-1) + a(n-2)
  #       denom continued fract converg to sqrt(5), 4-Fibonacci
  # each next = this*4 + prev

  require Math::PlanePath::FibonacciWordKnott;
  require Math::BaseCnv;
  require Math::NumSeq::BalancedBinary;
  my $path = Math::PlanePath::FibonacciWordKnott->new;
  my %seen;
  my %diffs; require Tie::IxHash; tie %diffs, 'Tie::IxHash';

  foreach my $n ($path->n_start .. 10000) {
    my ($x,$y) = $path->n_to_xy($n);
    if (my $p = $seen{$x,$y}) {
      my $d = $n - $p;
      # print "$x,$y  $p $n  diff $d\n";
      $diffs{$d} ||= 1;
    }
    $seen{$x,$y} = $n;
  }
  my $bal = Math::NumSeq::BalancedBinary->new;
  foreach my $d (keys %diffs) {
    my $b = Math::BaseCnv::cnv($d,10,2);
    my $z = $bal->ith($d);
    $z = Math::BaseCnv::cnv($z,10,2);
    print "$d  bin=$b  zeck=$z\n";
  }
  exit 0;
}
{
  # Dense Fibonacci Word turns
  require Math::NumSeq::FibonacciWord;

  require Image::Base::Text;
  my $image = Image::Base::Text->new (-width => 79, -height => 40);
  my $foreground = '*';
  my $doubleground = '+';

  # require Image::Base::GD;
  # $image = Image::Base::GD->new (-width => 200, -height => 200);
  # $image->rectangle (0,0, 200,200, 'black');
  # $foreground = 'white';
  # $doubleground = 'red';

  my $seq = Math::NumSeq::FibonacciWord->new (fibonacci_word_type => 'dense');
  my $dx = 1;
  my $dy = 0;
  my $x = 1;
  my $y = 1;

  my $transpose = 1;

  my $char = sub {
    if ($transpose) {
      if (($image->xy($y,$x)//' ') eq $foreground) {
        $image->xy ($y,$x, $doubleground);
      } else {
        $image->xy ($y,$x, $foreground);
      }
    } else {
      if (($image->xy($x,$y)//' ') eq $foreground) {
        $image->xy ($x,$y, $doubleground);
      } else {
        $image->xy ($x,$y, $foreground);
      }
    }
  };
  my $draw = sub {
    &$char ($x,$y);
    $x += $dx;
    $y += $dy;
    &$char ($x,$y);
    $x += $dx;
    $y += $dy;
    # &$char ($x,$y);
    # $x += $dx;
    # $y += $dy;
  };

  my $natural = sub {
    my ($value) = @_;
    &$draw();
    if ($value == 1) {
      ($dx,$dy) = (-$dy,$dx);
    } elsif ($value == 2) {
      ($dx,$dy) = ($dy,-$dx);
    }
  };

  my $apply;

  $apply = sub {
    # dfw natural, rot +45
    my ($i, $value) = $seq->next;
    &$natural($value);
  };

  # # plus, rot -45
  # $apply = sub {
  #   my ($i, $value) = $seq->next;
  #   if ($value == 0) {
  #     # empty
  #   } else {
  #     &$natural($value);
  #   }
  # };
  # $x += 20;
  # $y += 20;

  $apply = sub {
    # standard
    my ($i, $value) = $seq->next;
    if ($value == 0) {
      &$natural(1);
      &$natural(2);
    } elsif ($value == 1) {
      &$natural(1);
      &$natural(0);
    } else {
      &$natural(0);
      &$natural(2);
    }
  };

  # $x += 2;
  # $y += int ($image->get('-height') / 2);
  # $apply = sub {
  #   # rot pi/5 = 36deg  curly
  #   my ($i, $value) = $seq->next;
  #   if ($value == 0) {
  #     &$natural(2);
  #     &$natural(1);
  #   } elsif ($value == 1) {
  #     &$natural(0);
  #     &$natural(2);
  #   } else {
  #     &$natural(1);
  #     &$natural(0);
  #   }
  # };

  # $x += 20;
  # $y += 20;
  $apply = sub {
    # expanded
    my ($i, $value) = $seq->next;
    if ($value == 0) {
      &$natural(0);
      &$natural(1);
      &$natural(0);
      &$natural(2);
    } elsif ($value == 1) {
      &$natural(0);
      &$natural(1);
      &$natural(0);
    } else {
      &$natural(0);
      &$natural(0);
      &$natural(2);
    }
  };

  $apply = sub {
    # Ron Knott
    my ($i, $value) = $seq->next;
    if ($value == 0) {
      &$natural(1);
      &$natural(2);
    } else {
      &$natural($value);
    }
  };

  print "$x,$y\n";

  for (1 .. 2000) {
    &$apply();
  }

  # $image->save('/tmp/x.png');
  # system('xzgv /tmp/x.png');

  my $lines = $image->save_string;
  my @lines = split /\n/, $lines;
  $, = "\n";
  print reverse @lines;

  exit 0;
}

{
  my @xend = (0,0,1);
  my @yend = (0,1,1);
  my $f0 = 1;
  my $f1 = 2;
  my $level = 1;
  my $transpose = 0;
  my $rot = 0;

  ### at: "$xend[-1],$xend[-1] for $f1"

  foreach (1 .. 20) {
    ($f1,$f0) = ($f1+$f0,$f1);
    my $six = $level % 6;
    $transpose ^= 1;

    my ($x,$y);
    if (($level % 6) == 0) {
      $x = $yend[-2];     # T
      $y = $xend[-2];
    } elsif (($level % 6) == 1) {
      $x = $yend[-2];      # -90
      $y = - $xend[-2];
    } elsif (($level % 6) == 2) {
      $x = $xend[-2];     # T -90
      $y = - $yend[-2];

    } elsif (($level % 6) == 3) {
      ### T
      $x = $yend[-2];     # T
      $y = $xend[-2];
    } elsif (($level % 6) == 4) {
      $x = - $yend[-2];     # +90
      $y = $xend[-2];
    } elsif (($level % 6) == 5) {
      $x = - $xend[-2];     # T +90
      $y = $yend[-2];
    }

    push @xend, $xend[-1] + $x;
    push @yend, $yend[-1] + $y;
    ### new: ($level%6)." add $x,$y for $xend[-1],$yend[-1]  for $f1"
    $level++;
  }
  exit 0;
}

{
  my @xend = (0, 1);
  my @yend = (1, 1);
  my $f0 = 1;
  my $f1 = 2;

  foreach (1 .. 10) {
    {
      ($f1,$f0) = ($f1+$f0,$f1);
      my ($nx,$ny) = ($xend[-1] + $yend[-2], $yend[-1] + $xend[-2]); # T
      push @xend, $nx;
      push @yend, $ny;
      ### new 1: "$nx, $ny    for $f1"
    }

    {
      ($f1,$f0) = ($f1+$f0,$f1);
      my ($nx,$ny) = ($xend[-1] + $xend[-2], $yend[-1] - $yend[-2]); # T ...
      push @xend, $nx;
      push @yend, $ny;
      ### new 2: "$nx, $ny    for $f1"
    }

    {
      ($f1,$f0) = ($f1+$f0,$f1);
      my ($nx,$ny) = ($xend[-1] + $yend[-2], $yend[-1] + $xend[-2]); # T
      push @xend, $nx;
      push @yend, $ny;
      ### new 3: "$nx, $ny    for $f1"
    }

    {
      ($f1,$f0) = ($f1+$f0,$f1);
      my ($nx,$ny) = ($xend[-1] + $yend[-2], $yend[-1] + $xend[-2]);  # T
      push @xend, $nx;
      push @yend, $ny;
      ### new 1b: "$nx, $ny    for $f1"
    }

    {
      ($f1,$f0) = ($f1+$f0,$f1);
      my ($nx,$ny) = ($xend[-1] - $xend[-2], $yend[-1] + $yend[-2]); # T +90
      push @xend, $nx;
      push @yend, $ny;
      ### new 2b: "$nx, $ny    for $f1"
    }

    {
      ($f1,$f0) = ($f1+$f0,$f1);
      my ($nx,$ny) = ($xend[-1] + $yend[-2], $yend[-1] + $xend[-2]); # T
      push @xend, $nx;
      push @yend, $ny;
      ### new 1c: "$nx, $ny    for $f1"
    }

    {
      ($f1,$f0) = ($f1+$f0,$f1);
      my ($nx,$ny) = ($xend[-1] + $yend[-2], $yend[-1] - $xend[-2]);  # rot -90
      push @xend, $nx;
      push @yend, $ny;
      ### new 2c: "$nx, $ny    for $f1"
    }

  }
  exit 0;
}