絡み目の不変量の計算

#!/usr/bin/perl

##Linuxはこの３行のコメントを外す;

#require "/home/username/jones/poly.pl";

#require "/home/username/jones/asmoothing.pl";

#require "/home/username/jones/bsmoothing.pl";

##Winodowsはこの３行のコメントを外す;

require "C:/Users/username/jones/poly.pl";

require "C:/Users/username/jones/asmoothing.pl";

require "C:/Users/username/jones/bsmoothing.pl";

(my $o_link,my $o_sign) = splice(@ARGV, 0, 2);

&jones_answer(eval $o_link,eval $o_sign);

sub jones_answer {

    my($link,$sign) = @_;

    my($origsign,$poly1,$writhe,$number,$jones,$jonespoly,$poly2,$y,$orignum,$t,$n);

    print "links is ";

    &print_matrix($link);

    print "sign is ";

    &print_matrix([$sign]);

    @{$origsign} = @{$sign};

    $poly1 = &jones_say_all($link,$sign); 

    $poly2 = &from_d_to_a($poly1);

    print "bracket polynomial is\n";

    #&print_out($poly2);

    &print_format($poly2);

    for($y=0; $y<@{$origsign}; $y++) {

$writhe += $$origsign[$y];

    }

    $orignum=1;

    if ($writhe < 0) {

$t = -$writhe;

    }else {

$t = $writhe;

    }

    for ($n=1; $n<$t+1; ++$n) {

$orignum = -1*$orignum;

    }

    $number = 3 * (-$writhe) + 0 ;

    $jones = &poly_multiple($poly2,[[$orignum,[a,$number]]]);

    print "normalized bracket polynomial is\n";

    #&print_out($jones);

    &print_format($jones);

    $jonespoly = &from_a_to_t($jones);

    print "jones polynomial is\n";

    #&print_out($jonespoly);

    &print_format($jonespoly);

}

sub jones_say_all {

    my($link,$sign) = @_;

    my($i,$p,$poly,$x,$b);

    my(@l);

    $x=0;

    foreach $b (@{$link}) {

$x += @{$b};

    }

    if ($x != 0) {

@l = @{$link};

until (@{$l[0]}) {

    splice(@l,0,1);

    push(@l,[]);

}

$link = [@l];

$i = ${$link}[0][0];

if ($i<0) {

    $p = -$i;

}else {

    $p = $i;

}

    }

    $poly = &link_program($link,$i,$sign,$p);

    $poly;

}

sub link_program {

    my($link,$i,$sign,$p) = @_;

    if ($i) {

my($poly1,$link1,$poly2,$new_sign1,$new_sign2,$link2,$origsign,$blacket1,$blacket2,$number,$link9,$origsign0,$t,$y);

@{$origsign} = @{$sign};

@{$origsign0} = @{$sign};

$t = $$sign[$p-1];

($poly1,$new_sign1) = &aplus_bminus_smoothing($link,$i,$origsign0,$p);

$link1 = &jones_say_all($poly1,$new_sign1);

$y = $$origsign[$p-1];

($poly2,$new_sign2) = &aminus_bplus_smoothing($link,$i,$origsign,$p);

$link2 = &jones_say_all($poly2,$new_sign2);

if ($t == 1 || $y == 1) {

    $blacket1 = &poly_var_multiple($link1,['a',1]);

    $blacket2 = &poly_var_multiple($link2,['a',-1]);

}else {

    $blacket1 = &poly_var_multiple($link1,['a',-1]);

    $blacket2 = &poly_var_multiple($link2,['a',1]);

}

$link9 = &poly_plus($blacket1,$blacket2);

$link9;

    }else {

$number = @{$link};

[[1, ['d',$number-1]]];

    }

}

1;

#!/usr/bin/perl

sub aplus_bminus_smoothing {

  my($link,$i,$sign,$p) = @_;

  my($column,$e,$d,$q,$c,$a,$b,$f,$foo4);

  my(@columns,@vertex1,@vertex2);

  for ($q=0; $q<@{$link}; $q++){

      $column = @{${$link}[$q]};

      push (@columns,$column);

  }

  $c = 1;

  for ($e=0; $e<@{$link};){

      for ($d=$c; $d<@{$$link[$e]}; $d++){

  if ($$link[$e][$d] != -$i) {

      push(@vertex1,$$link[$e][$d]);

  }elsif ($$link[$e][$d] == -$i) {

      if ($e == 0) {

  push (@vertex2,[@vertex1]);

  @vertex1 = ();

      }else{

  push(@{${\@vertex2}[0]},@{$$link[$e]}[($d + 1) .. $columns[$e]-1],@vertex1);

  @vertex1 = ();

  last;

      }

  }

      }

    if (@vertex1) {

      push (@vertex2,[@vertex1]);

    }elsif ($columns[$e] == 0) {

      push(@vertex2,[]);

    }elsif ($e == 0 && $$link[$e][$columns[$e]-1] == -$i) {

      push (@vertex2,[@vertex1]);

    }

    @vertex1 = ();

    $e++;

    $c = 0;

  }

  $foo4 = [@vertex2];

  for ($a=0; $a<@{$foo4}; ++$a){

    for ($b=0; $b<@{$$foo4[$a]}; ++$b){

      $f = $$foo4[$a][$b]<0 ? -$$foo4[$a][$b] : $$foo4[$a][$b];

      if ($p < $f) {

if ($$foo4[$a][$b] < 0) {

  $$foo4[$a][$b] = $$foo4[$a][$b]+1;

}else {

  $$foo4[$a][$b] = $$foo4[$a][$b]-1;

}

      }

    }

  }

  splice(@{$sign},$p-1,1); 

  ($foo4,$sign);

}

1;

#!/usr/bin/perl

sub aminus_bplus_smoothing {

  my($link,$i,$sign,$p) = @_;

  my($column,$e,$d,$q,$c,$r,$t,$f,$a,$b,$foo4);

  my(@columns,@vertex1,@vertex2,@vertex3,@var,@var1,$vertex6);

  for ($q=0; $q<@{$link}; $q++){

    $column = @{$$link[$q]};

    push (@columns,$column);

  }

  $c = 1;

  for ($e=0; $e<@{$link};){

    for ($d=$c; $d<$columns[$e]; $d++){

      if ($$link[$e][$d] != -$i) {

  push(@vertex1,$$link[$e][$d]);

      }elsif ($$link[$e][$d] == -$i) {

        if ($e == 0) {

    @vertex3 = reverse (@{$$link[0]}[($d + 1) .. $columns[0]-1]);

  push (@vertex1,@vertex3);

          push (@vertex2,[@vertex1]);

    if (@vertex3) {

    for ($r=0; $r<@vertex3; $r++) {

      if ($vertex3[$r] < 0) {

$vertex3[$r] = $vertex3[$r]*(-1);

      }else{

$vertex3[$r] = $vertex3[$r];

      }

      $$sign[$vertex3[$r]-1] = $$sign[$vertex3[$r]-1]*(-1);

    }

  }

  @vertex1 = ();

  last;

}else{

    @var = reverse(@vertex1);

    @var1 = reverse (@{$$link[$e]}[($d + 1) .. $columns[$e]-1]);

    push(@var,@var1);

    $vertex6 = \@vertex2;

    push(@{$$vertex6[0]},@var);

  if (@var) {

    for ($t=0; $t<@var; $t++) {

      if ($var[$t] < 0) {

$var[$t] = $var[$t]*(-1);

      }else{

$var[$t] = $var[$t];

      }

      $$sign[$var[$t]-1] = $$sign[$var[$t]-1]*(-1);

    }

  }

  @vertex1 = ();

  last;

}

      }

    }

    if (@vertex1) {

      push (@vertex2,[@vertex1]);

    }elsif ($columns[$e] == 0) {

      push(@vertex2,[]);

    }

    @vertex1 = ();

    $e++;

    $c = 0;

  }

  $foo4 = [@vertex2];

  for ($a=0; $a<@{$foo4}; ++$a){

    for ($b=0; $b<@{$$foo4[$a]}; ++$b){

      $f = $$foo4[$a][$b]<0 ? -$$foo4[$a][$b] : $$foo4[$a][$b];

      if ($p < $f) {

if ($$foo4[$a][$b] < 0) {

  $$foo4[$a][$b] = $$foo4[$a][$b]+1;

}else {

  $$foo4[$a][$b] = $$foo4[$a][$b]-1;

}

      }

    }

  }

  splice(@{$sign},$p-1,1);

  ($foo4,$sign);

}

1;

#!/usr/bin/perl

#出た結果を式に直す。

sub print_format {

    my($poly) = @_;

    my($x,$y);

    for ($x=0; $x<@{$poly}; $x++) {

if ($x == 0) {

    print "($$poly[0][0])";

}else {

    print " + ($$poly[$x][0])";

}

for ($y=1; $y<@{${$poly}[$x]}; $y++) {

    print " * (${$poly}[$x][$y][0] ^ ${$poly}[$x][$y][1])";

}

    }

    print "\n";

}

sub poly_normalize {

    my($poly) = @_;

    my($mono,$c,$var1,$var2);

    my(@poly,@new_mono,@mono);

    foreach $mono (@{$poly}){

($c,@mono) = @{$mono};

@new_mono = ($c);

if (@mono){

    ($var1,@mono) = sort alphavet @mono;

    while (@mono){

$var2 = shift (@mono);

if (${$var1}[0] eq ${$var2}[0]){

    $var1 = [${$var1}[0],${$var1}[1] + ${$var2}[1]];

}else{

    push (@new_mono,$var1);

    $var1 = $var2;

}

    }

    push(@new_mono, $var1);

}

push (@poly,[@new_mono]);

    }

    if (@poly > 0) {

my(@new,@rest);

my($mono1,$mono2);

($mono1, @rest) = sort {&cmp_sorted_mono($a,$b);} @poly;

while (@rest) {

    $mono2 = shift(@rest);

    if (${$mono1}[0] == 0){

$mono1 = $mono2;

    }elsif(!&cmp_sorted_mono($mono1, $mono2)) {

$mono1 = [${$mono1}[0] + ${$mono2}[0], @{$mono1}[1 .. $#$mono1]];

    }

    else {

push(@new, $mono1);

$mono1 = $mono2;

    }

}

if (${$mono1}[0] == 0){

    $poly = [@new];

}else{

    $poly = [@new, $mono1];

}

    }else {

$poly = [];

    }

    $poly;

}

sub cmp_sorted_mono {

    my($mono1, $mono2) = @_;

    my(@m1) = @{$mono1}[1..$#{$mono1}];

    my(@m2) = @{$mono2}[1..$#{$mono2}];

    my($i, $result);

    for ($i=0; $i<@m1; $i++){

return 1 unless ($i < @m2);

$result = $m1[$i][0] cmp $m2[$i][0];

return $result if ($result);

$result = $m1[$i][1] <=> $m2[$i][1];

return $result if ($result);

    }

    @m1 <=> @m2;

}

sub alphavet { ${$a}[0] cmp ${$b}[0]; }

sub poly_var_multiple {

    my($poly) = shift;

    my(@poly, $mono, @mono);

    foreach $mono (@{$poly}) {

@mono = @{$mono};

foreach $var (@_) {

    push(@mono, [@{$var}]);

}

push(@poly,[@mono]);

    }

    &poly_normalize(\@poly);

}

sub poly_mono_multiple {

    my($poly) = shift;

    my($i,$c,$a,$y,$b,$mono);

    my(@poly2,@number,@result,@vars);

    foreach $mono (@_) {

push(@number,${$mono}[0]);

for ($i=1; $i<@{$mono}; $i++){

    push(@poly2,[@{${$mono}[$i]}]);

}

    }

    for ($y=0; $y<@{$poly}; $y++) {

($c, @vars) = @{${$poly}[$y]};

foreach $b (@number) {

    $c *= $b;

}

push(@result, [$c, @vars]);

    }

    &poly_var_multiple([@result],@poly2);

}

sub poly_multiple {

    my($poly,$poly3,@poly7) = @_;

    my($poly2,$b,$poly5,$poly9,$poly10,$x,$i);

    my(@poly4,@poly8);

    if ($$poly[0][0] == 0) {

$poly5 = [[0]];

    }else {

for ($x=0; $x<@{$poly3}; $x++){

    my(@mono2);

    push(@mono2,@{$$poly3[$x]});

    $poly2 = &poly_mono_multiple($poly,[@mono2]);

    foreach $b (@{$poly2}) {

push(@poly4,$b);

    }

}

if (@poly7) {

    if (@{$poly3}) {

for ($i=1; $i<@poly7; $i++) {

    push(@poly8,$poly7[$i]);

}

$poly9 = &poly_multiple([@poly4],$poly7[0],@poly8);

$poly5 = &poly_normalize($poly9);

    }else{

$poly10 = &poly_multiple([@poly4],$poly7[0],[]);

$poly5 = &poly_normalize($poly10);

    }

}else {

    $poly5 = &poly_normalize([@poly4]);

} 

    }

    $poly5;

}

sub poly_plus {

    my(@poly1) = @_;

    my($x,$poly0,$poly1);

    my(@poly);

    for ($x=0; $x<@poly1; $x++) {

push(@poly,@{$poly1[$x]});

    }

    $poly0 = &poly_normalize([@poly]);

    $poly0;

}

sub from_d_to_a {

    my($poly) = @_;

    my($e,$c,$x,$poly5,$i,$poly7,$poly8,$r);

    my(@poly10,@mono,@poly3);

    for ($e=0; $e<@$poly; $e++) {

@poly10 = ();

$poly5 = [[1]];

($c,@mono) = @{$$poly[$e]};

for ($x=0; $x<@mono; $x++) {

    if ($mono[$x][0] eq "d") {

$poly5 = [[-1,[a,2]],[-1,[a,-2]]];

##dの累乗は負というこはありえない;

if ($mono[$x][1] > 1) {

    for ($i=0; $i<$mono[$x][1]-1; ++$i) {

$poly5 = &poly_multiple($poly5,[[-1,[a,2]],[-1,[a,-2]]]);

    }

}elsif ($mono[$x][1] == 0) {

    $poly5 = [[1]];

}

    }else {

push(@poly10,@mono[$x]);

    }

}

$poly7 = &poly_multiple($poly5,[[$c,@poly10]]);

push(@poly3,$poly7);

    }

    $poly8 = [[0]];

    for ($r=0; $r<@poly3; ++$r) {

$poly8 = &poly_plus($poly8,@poly3[$r]);

    }

    $poly8;

}

sub from_a_to_t {

    my($poly) = @_;

    my($e,$c,$x,$poly0);

    my(@mono,@poly10);

    for ($e=0; $e<@$poly; ++$e) {

($c,@mono) = @{$$poly[$e]};

for ($x=0; $x<@mono; $x++) {

    if ($mono[$x][0] eq "a") {

if ($mono[$x][1] == 0) {

    push(@poly10,[$c]);

}else {

    push(@poly10,[$c,[t,-1/4*$mono[$x][1]]]);

}

    }else {

push(@poly10,[$c,@mono[$x]]);

    }

}

    }

    $poly0 = &poly_normalize([@poly10]);

    $poly0;

}

sub print_mono {

    my($mono) = @_;

    my($c, @vars) = @$mono;

    local($") = ', ';

    print "[$c";

    foreach (@vars) {

print ", [@$_]";

    }

    print "]\n";

}

sub print_out {

    my($poly) = @_;

    my($sep);

    print "[";

    foreach (@{$poly}) {

print $sep;

&print_mono($_);

$sep = ', ';

    }

    print "]\n";

}

sub print_matrix {

    my($poly) = @_;  

    print "[";

    foreach (@{$poly}) {

print "[";

foreach (@$_) {

    print "$_, ";

}

print "],";

    }

    print "]\n";

}

1;