#! /usr/bin/perl
# program to compute Laver tables (and S($N) tables);

use Tk;
use strict;
# use warnings;
use FileHandle; STDOUT->autoflush(1);
require Tk::BrowseEntry;
require Tk::Dialog;

my $N = 2;       # $N is number of rows;
my @rows;         # entry at (m, n) is $rows[$m][$n]
my ($m, $n);      # $rows[$m][0] is the period of the row
my $l;

my $type = 'periods';
my $line = 1;
my $doubling = 'no';
my $clearing = 'no';
my $fontstyle = "Courier";
my $fontsize = "10";
my $font = $fontstyle . " $fontsize";
my $co1 = "#bde7ff";   # colors
my $co2 = "#70bfef";
my $co3 = "#3b8bdb";
my $bc1 = "#bde7ff";   # buttons
my $bc2 = "#70bfef";
my $bc3 = "#3b8bdb";
my $bgc1 = "#14107f";  # background color
my $N_col = "#5869d3";
my $scroll_c1 = $N_col;
my $scroll_c2 = $bgc1;
my $scroll_c3 = $scroll_c2;

my $main = MainWindow->new;
$main->title("Program to compute and display Laver Tables (written by Oliver Deiser, 2002)");
$main->geometry("1024x768+0+0");

#########################################################################################
#########################################################################################

my $frame = $main->Frame(-background => $bgc1);

my $frame1 = $frame->Frame(-background => $bgc1);
my $button1 = $frame1->Button(-text => "Exit",
			     -command => sub { exit; },
			     -background => $bc1,
			    )->pack(-side => 'top', -fill => 'x', padx => '0');
my $button2 = $frame1->Button(-text => "Info",
			     -command => sub { info(); },
			     -background => $bc2,
			    )->pack(-side => 'top', -fill => 'x', padx => '0');
my $button2b = $frame1->Button(-text => "Clear",
			     -command => sub { cleartext(); },
			     -background => $bc2,
			    )->pack(-side => 'top', -fill => 'x', padx => '0');
my $button2c = $frame1->Button(-text => "First Rows",
			     -command => sub { printfirstlines(); },
			     -background => $bc2,
			    )->pack(-side => 'top', -fill => 'x', padx => '0');
my $button3 = $frame1->Button(-text => "Compute",
			     -command => sub { start(); },
			     -background => $bc3,
 			    )->pack(-side => 'top', -fill => 'x', padx => '0');
my $button4 = $frame1->Button(-text => "Double N",
			     -command => sub { $N = $N * 2; },
			     -background => $bc3,
 			    )->pack(-side => 'top', -fill => 'x', padx => '0');


######################################################################################

my $frame2 = $frame->Frame(-background => $bgc1, -borderwidth => '0');
my $N_label = $frame2->Label(-text => ' N ', -background => $N_col)->pack(-pady => '2', -side => 'left');
my $N_entry = $frame2->Entry(-textvariable => \$N, -width => '5',
			      -highlightthickness => '0',
			    )->pack(-side => 'left', -padx => '0', -fill => 'x', -expand => '1');


#######################################################################################

my $frame3 = $frame->Frame(-background => $bgc1, -borderwidth => '0'); 
my $radiobutton_a = $frame3->Radiobutton(-text => "All Periods  ", 
					 -background => $N_col, 
					 -variable => \$type,
					 -value => 'periods',
					 -highlightbackground => $bgc1,
					 -selectcolor => $bgc1,
					);
$radiobutton_a->pack(-side => 'top', expand => '1', -fill => 'x',
		   -padx => '0',
		   -pady => '1',
		  );
my $radiobutton_b = $frame3->Radiobutton(-text => "Whole Table", 
					 -background => $N_col, 
					 -variable => \$type,
					 -value => 'whole',
					 -highlightbackground => $bgc1,
					 -selectcolor => $bgc1,
					);
$radiobutton_b->pack(-side => 'top', expand => '1', -fill => 'x',
		   -padx => '0',
		   -pady => '1',
		  );
my $radiobutton_c = $frame3->Radiobutton(-text => "Row - Col.  ", 
					 -background => $N_col, 
					 -variable => \$type,
					 -value => 'linerow',
					 -highlightbackground => $bgc1,
					 -selectcolor => $bgc1,
					);
$radiobutton_c->pack(-side => 'top', expand => '1', -fill => 'x',
		   -padx => '0',
		   -pady => '1',
		  );
my $radiobutton_d = $frame3->Radiobutton(-text => "Row           ", 
					 -background => $N_col, 
					 -variable => \$type,
					 -value => 'line',
					 -highlightbackground => $bgc1,
					 -selectcolor => $bgc1,
					);
$radiobutton_d->pack(-side => 'top', -fill => 'x', -anchor => 'e',
		   -padx => '0',
		   -pady => '1',
		  );

my $linesframe = $frame3->Frame(-background => $bgc1, -borderwidth => '0');
my $L_label = $linesframe->Label(-text => ' Row ', -background => $N_col,
				 )->pack(-padx => '0', -side => 'left', -fill => 'x', expand => '1');
my $L_entry = $linesframe->Entry(-textvariable => \$line, -width => '5',
			      -highlightthickness => '0',
			    )->pack(-side => 'left', -padx => '0', -fill => 'x', -expand => '1');
$linesframe->pack(-pady => '4', -padx => '0', side => 'top', fill => 'x');


#########################################################################################

my $frame4 = $frame->Frame(-background => $bgc1, -borderwidth => '0');
my $fontsframe = $frame4->Frame(-background => $bgc1, -borderwidth => '0');
my $font_label = $fontsframe->Label(-text => 'Fontsize', -background => $N_col)
  ->pack(-padx => '0', -side => 'left');
my $font_entry = $fontsframe->Entry(-textvariable => \$fontsize, -width => '1',
				   -highlightthickness => '0',
			    )->pack(-side => 'left', -padx => '0', -fill => 'x', -expand => '1');
$fontsframe->pack(-pady => '4', -padx => '0', side => 'top', fill => 'x');

my $typesframe = $frame4->Frame(-background => $bgc1, -borderwidth => '0');
my $rad1 = $typesframe->Radiobutton(-text => "Courier", -background => $N_col, 
				   -variable => \$fontstyle,
				   -value => 'Courier',
				   -highlightbackground => $bgc1,
				   -selectcolor => $bgc1,
				    );

my $rad2 = $typesframe->Radiobutton(-text => "Roman", -background => $N_col, 
				   -variable => \$fontstyle,
				   -value => 'Roman',
				   -highlightbackground => $bgc1,
				   -selectcolor => $bgc1,
				  );
$rad1->pack(-side => 'top', expand => '1', -fill => 'x', -anchor => 'w');
$rad2->pack(-side => 'top', expand => '1', -fill => 'x', -anchor => 'w');
$typesframe->pack(-pady => '4', -padx => '0', side => 'top', fill => 'x');

#########################################################################################

my $frame5 = $frame->Frame(-background => $bgc1, -borderwidth => '0');  
my $check1 = $frame5->Checkbutton(-text => "Doubling", 
				    -background => $N_col, 
				    -variable => \$doubling,
				    -onvalue => 'yes',
				    -offvalue => 'no',
				    -highlightbackground => $bgc1,
				    -selectcolor => $bgc1,
				  );
my $check2 = $frame5->Checkbutton(-text => "Clearing", 
				    -background => $N_col, 
				    -variable => \$clearing,
				    -onvalue => 'yes',
		       	    -offvalue => 'no',
				    -highlightbackground => $bgc1,
				    -selectcolor => $bgc1,
				  );
$check1->pack(-side => 'top', expand => '1', -fill => 'x',
					  -pady => '0',
					  -anchor => 'w');
$check2->pack(-side => 'top', expand => '1', -fill => 'x',
					  -pady => '4',
					  -anchor => 'w');

########################################################################################

$frame1->pack(-side => 'top', -anchor => 'n', pady => '8', -padx => '8', -fill => 'x');
$frame2->pack(-pady => '4', -padx => '8', side => 'top', fill => 'x');
$frame3->pack(-pady => '16', -padx => '8', side => 'top', fill => 'x');
$frame5->pack(-pady => '32', -padx => '8', side => 'top', fill => 'x');
$frame4->pack(-pady => '32', -padx => '8', side => 'top', fill => 'x');

$frame->pack(-side => 'right', -anchor => 'n', -fill => 'y');

#########################################################################################
#########################################################################################

my $frametext = $main->Frame(-background => $bgc1);
my $y_scroll = $frametext->Scrollbar(-troughcolor => $scroll_c1,
				     -background => $scroll_c2,
				     -activebackground => $scroll_c3,	
				     -highlightthickness => '0',
                                     -elementborderwidth => '0',
				     -borderwidth => '0',
				    );
my $x_scroll = $frametext->Scrollbar(-orient => 'horizontal',
				     -troughcolor => $scroll_c1,
				     -background => $scroll_c2,
				     -activebackground => $scroll_c3,
				     -highlightthickness => '0',
                                     -elementborderwidth => '0',
				     -borderwidth => '0',
				    );
my $text = $frametext->Text(-borderwidth => 0,
			    -foreground => 'black',
			    -background => 'white',
			    -font => $font,
			    -padx => '18',
			    -pady => '2', 
			    -yscrollcommand => ['set' => $y_scroll],	
			    -xscrollcommand => ['set' => $x_scroll],
			    -wrap => 'none',
			    -spacing3 => '3',
			   );
$y_scroll->configure(-command => ['yview' => $text]);
$x_scroll->configure(-command => ['xview' => $text]);
$y_scroll->pack(-side => 'left', -fill => 'both');
$x_scroll->pack(-side => 'bottom', -fill => 'both');
$text->pack(-side => 'left',
	    -anchor => 'c',
	    -padx => '0', -pady => '0',
	    -fill => 'both',
	    -expand => '1',
	   
	      );
$frametext->pack(-fill => 'both', -expand => '1');

#########################################################################################

MainLoop();

#########################################################################################

sub tags { 
  $text->tagConfigure('c1', -foreground => "#af8624", -font => $font);
  $text->tagConfigure('c2', -foreground => "#543a05", -font => $font . " bold");
  $text->tagConfigure('c3', -foreground => "#1313c6", -font => $font . " bold");
  $text->tagConfigure('c4', -foreground => "#299e2d", -font => $font . " bold");
  $text->tagConfigure('c5', -foreground => "#d6374c", -font => $font . " bold");
  $text->tagConfigure('c6', -foreground => "#e50926", -font => $font . " bold");
}


sub start {
  $font = $fontstyle . " $fontsize";
  tags();
  formats();
  computetable();
  if ($type eq 'whole') { printfulltable(); }
  elsif ($type eq 'linerow') { printcolored_rows(); $line-- if ($line >= 2); }
  elsif ($type eq 'periods') { printtable(); }
  else { printline(); }

  $N *= 2 if ($doubling eq 'yes');
  return();
}

sub computetable {            # everthing but this is just handling the output ...
  for ($m = 1; $m < $N; $m++) {    # initialize table: first column get id + 1, last row get id;
    $rows[$m][1] = $m + 1;
    $rows[$N][$m] = $m;
  }
  $rows[$N][0] = $rows[$N][$N] = $N;

  for ($m = $N - 1; $m > 0; $m--) {    # compute Laver table entries and periods
    for ($n = 2; ; $n++) {             # we are computing row by row, backwards
      my $r = $rows[$m][$n - 1];
      last if ($r == $N);       # we are done with row $m: last entry was $N
      my $k = ($m + 1) % $rows[$r][0];
      $k += $rows[$r][0] if ($k == 0);
      $rows[$m][$n] = $rows[$r][$k];    # table-entry at $m, $n
    }
    $rows[$m][0] = $n - 1;    # period of row $m
  }
}


sub printtable {
  commonprint();
  for ($m = 1; $m <= $N; $m++) {
    my $f = " " x ($l - length($m . ""));
    $text->insert('end', "$f", 'c1'); 
    $text->insert('end', "$m ", 'c3'); 
     for ($n = 1; ; $n++) {
      my $e = $rows[$m][$n];
      my $f = " " x ($l - length($e . ""));
      $text->insert('end', "$f", 'c2'); 
      $text->insert('end', "$e ", 'c2');     
      if ($m == $N and $N >= 128 and $n >= 4) {
	$text->insert('end', " " x ($l - 3) . " ...", 'c2');
	last;
      }
      last if ($e == $N);
    }
    $text->insert('end', "\n", 'c1');
  }
  $text->yviewMoveto(1);
}

sub printfulltable {
  commonprint();
  for ($m = 1; $m <= $N; $m++) {
    my $f = " " x ($l - length($m . ""));
    $text->insert('end', "$f", 'c1'); 
    $text->insert('end', "$m ", 'c3'); 
    my $per = $rows[$m][0];
    for ($n = 1; $n <= $N; $n++) {
      my $n2 = $n % $per;
      if ($n2 == 0) { $n2 = $per; }
      my $e = $rows[$m][$n2];
      my $f = " " x ($l - length($e . ""));
      $text->insert('end', "$f", 'c1'); 
      if ($n <= $per) {
	$text->insert('end', "$e ", 'c2');     
      }
      else {
	$text->insert('end', "$e ", 'c1');     
      }	
      }
    $text->insert('end', "\n", 'c1');
  }
  $text->yviewMoveto(1);
}

sub printline {
  cleartext() if ($clearing eq 'yes');
  $text->insert('end', "\n", 'c1');
  my $per = $rows[$line][0];
  for ($n = 1; $n <= $per; $n++) {
    my $f = " " x (length($rows[$line][$n] . "") - length($n . "")); 
    $text->insert('end', "$f", 'c1'); 
    $text->insert('end', "$n ", 'c3'); 
  }
  $text->insert('end', "\n", 'c1');
  for ($n = 1; $n <= $per; $n++) {
    my $e = $rows[$line][$n];
    $text->insert('end', "$e ", 'c2');     
  }
  $text->insert('end', "\n", 'c1');
  $text->yviewMoveto(1);
}

sub printcolored_rows {
  my $i = 1;
  commonprint();
  for ($m = 1; $m <= $N; $m++) {
    my $f = " " x ($l - length($m . ""));
    $text->insert('end', "$f", 'c1'); 
    $text->insert('end', "$m ", 'c3'); 
    my $per = $rows[$m][0];
    for ($n = 1; $n <= $N; $n++) {
      my $n2 = $n % $per;
      if ($n2 == 0) { $n2 = $per; }
      my $e = $rows[$m][$n2];
      my $f = " " x ($l - length($e . ""));
      $text->insert('end', "$f", 'c1'); 
      if ($m == $line and $n <= $per) {
	$text->insert('end', "$e ", 'c6');  
      }
      elsif ($n == $line + 1 and ($m == $N or $m == $rows[$line][$i])) {
	$text->insert('end', "$e ", 'c6');  
	$i++;
      }
      elsif ($n <= $per) {
	$text->insert('end', "$e ", 'c2');
      }
      else {
	$text->insert('end', "$e ", 'c1');     
      }	
      }
    $text->insert('end', "\n", 'c1');
  }
  $text->yviewMoveto(1);
}

sub commonprint {
  cleartext() if ($clearing eq 'yes');
  $text->insert('end', "\n", 'c1');
  $text->insert('end', " " x $l . " ", 'c1');
  for ($n = 1; $n <= $N; $n++) {
    my $f = " " x ($l - length($n . ""));
    $text->insert('end', "$f", 'c1'); 
    $text->insert('end', "$n ", 'c3'); 
  }
   $text->insert('end', "\n", 'c1');
}

sub formats {
  $l = length($N . "");
}

sub cleartext {
  $text->delete("1.0", 'end');
}

sub printfirstlines {
  my $i;
  my @l;
  my $z = 20;
  my $ml = 6;

  $l[0] = "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16";
  $l[1] = "1";
  $l[2] = "2";
  $l[3] = "2 4";
  $l[4] = "2 4 6 8"; 
  $l[5] = "2 12 14 16"; 
  $l[6] = "2 12 14 16 18 28 30 32"; 
  $l[7] = "2 12 14 48 50 60 62 64"; 
  $l[8] = "2 12 14 112 114 124 126 128"; 
  $l[9] = "2 12 14 240 242 252 254 256"; 
  $l[10] = "2 12 14 240 242 252 254 256 258 268 270 496 498 508 510 512"; 
  $l[11] = "2 12 14 240 242 252 254 768 770 780 782 1008 1010 1020 1022 1024";
  $l[12] = "2 12 14 240 242 252 254 1792 1794 1804 1806 2032 2034 2044 2046 2048"; 
  $l[13] = "2 12 14 240 242 252 254 3840 3842 3852 3854 4080 4082 4092 4094 4096";
  $l[14] = "2 12 14 240 242 252 254 7936 7938 7948 7950 8176 8178 8188 8190 8192";
  $l[15] = "2 12 14 240 242 252 254 16128 16130 16140 16142 16368 16370 16380 16382 16384";
  $l[16] = "2 12 14 240 242 252 254 32512 32514 32524 32526 32752 32754 32764 32766 32768";
  $l[17] = "2 12 14 240 242 252 254 65280 65282 65292 65294 65520 65522 65532 65534 65536";
  $l[18] = "2 12 65550 65776 65778 65788 65790 130816 130818 130828 130830 131056 131058 131068 131070 131072";
  $l[19] = "2 12 196622 196848 196850 196860 196862 261888 261890 261900 261902 262128 262130 262140 262142 262144";
  $l[20] = "2 12 458766 458992 458994 459004 459006 524032 524034 524044 524046 524272 524274 524284 524286 524288";



  $font = $fontstyle . " $fontsize";
  tags();
  $text->insert('end', "\n\nThe following table displays the periods of the first rows of the first $z Laver tables\n\n", 'c2');
  for ($i = 0; $i <= $z; $i++) {
    my @a = split(" ", $l[$i]);
    if ($i == 0) { $text->insert('end', "        ", 'c2');  }
    else { my $j = $i - 1; $text->insert('end', "N = " . " " x (2 - length($j . "")) . "2^$j", 'c6'); } 
    for ($n = 0; $n < 16; $n++) {
      my $f = " " x ($ml - length($a[$n] . "")); 
      $text->insert('end', "$f", 'c2'); 
      $text->insert('end', $a[$n] . " ", $i == 0 ? 'c3' : 'c2');
    }
    if ($i != 0) {
      my $e = 2**($i - 1);
      $text->insert('end', " " x ($ml - length($e . "")) . "  $e\n", 'c6');
    } 
    else { $text->insert('end', "\n", 'c6'); }
  }
  $text->yviewMoveto(1);
}

sub info {
  my @a;
  my @b;
  my @c;
  my @d;
  $font = $fontstyle . " $fontsize";
  tags();
  $a[0] = "\nThis program computes for positive integers N an N x N matrix S(N).\n" .
    "We view S(N) as a binary operation * on the set { 1, 2, ..., N }.\n" .
      "S(N) is called a Laver Table iff N is of the form 2^k for some k >= 0.\n" .
      "The S(N) tables are uniquely characterized by the initial values\n\n";
  $a[1] = "m * 1 = m + 1  for 1 <= m < N,  N * 1 = 1,   ";
  $a[2] = "and the rule\n";
  $a[3] = "m * (n * 1) = (m * n) * (m * 1)  for all 1 <= m, n <= N.\n\n";
  $a[4] = "(m * n is the entry of S(N) in row m and column n.)\n" .
    "One shows that\n(1) the rows are periodic and that\n" .
      "(2) S(N) is a left distributive operation on { 1, ..., N } iff it is a Laver Table.\n";
  $a[5] = "(See Dehornoy's book 'Braids and Self-Distributivity', Birkhaeuser 2000, for more on these tables.)\n\n";

  $b[0] = "Let us shortly describe the options of this program.\n\n";
  $b[1] = "Clear: Clears the 'screen'.\n";
  $b[2] = "First Rows: Displays a precomputed list of the first row of the first 20 Laver Tables.\n" .
          "   (Some rows have been computed using a plain but fast version of the program written in C.)\n";
  $b[3] = "Compute: Does the computation and displays the result. This is the most important button.\n";
  $b[4] = "Double N: Doubles the N value. Just a convenient option.\n";
  $b[5] = "N: Specify the the value for N here.\n";
  $b[6] = "All Periods: If you check this button, only the periods of the rows will be displayed.\n";
  $b[7] = "Whole Table: The whole table S(N) will be displayed (after pressing 'Compute').\n";
  $b[8] = "Row - Column: This visualizes how the row specified in 'row' is computed using the column 'row' + 1\n" .
    "   (It might be instructive to start with the value for N (e.g. 32) and the clearing option checked.\n" .
      "   'row' is diminished by one automatically, so that the option can be easily iterated just\n   hitting 'Compute'." .	"   In this way the table S(N) is actually computed.)\n";
  $b[9] = "Row: Only the row specified will be displayed after hitting 'Compute'. Use this for large N.\n\n";

  $c[0] = "Doubling: N is automatically doubled after a computation.\n";
  $c[1] = "Clearing: The screen is automatically cleared before a new computation is displayed.\n";
  $c[2] = "Fontsize, Courier, Roman: Adjust the fonttype and fontsize according to your needs.\n\n";
  
  $d[0] = "The main open question is:\n\n" . 
    "Can one provide a 'simple' proof that the periods of the first rows of the Laver Tables converge to infinity?\n\n";
  $d[1] = "Convergence to infinity can up to now only be proved using strong large cardinal assumptions of set theory.\n";
  $d[2] = "It is also known that the periods of the first rows are <= 16 for all 'human values' N...\n";

  for ($n = 0; $n < scalar(@a); $n++) {
    $text->insert('end', $a[$n], 'c2');
  }
  for ($n = 0; $n < scalar(@b); $n++) {
    $text->insert('end', $b[$n], 'c3');
  }
  for ($n = 0; $n < scalar(@c); $n++) {
    $text->insert('end', $c[$n], 'c4');
  } 
  for ($n = 0; $n < scalar(@d); $n++) {
    $text->insert('end', $d[$n], 'c6');
  } 




}