絡み目の不変量の計算(その２)

交差点に数字を割り振って数字を並べるだけの計算手法

コンウェイ多項式の計算をすることができるプログラムです。

・準備

絡み目に向けを付けます。
絡み目の一つの交差点に１を付けて、紐の方向を辿りながら、番号を順番に付けます(既に番号がついているところは飛ばします)。
始点を１として、成分ごとに番号を書き出します、この時各成分を[　]で囲み、さらに全体を[　]で囲みます。
交差点の符号を１から順番に書き出し、全体を[ ]で囲みます。
[Windowsの場合]コマンドプロンプトでperl -vを実行して、perl がインストールされてなければ、ActivePerlかStrawberryPerlをインストールします。
[Windowsの場合] C:\Users\usernameの下にconwayディレクトを作ります。[Linuxの場合] /home/usernameの下にconwayディレクトリを作ります。
conwayディレクトリにconway.pl、crossing.pl、smoothing.pl、poly.plファイルを置きます。（絡み目の不変量の計算(その１)でjonesディレクトリにpoly.plを置いた人はconwayディレクトリにpoly.plを置く必要はないです）
conway.plの４～８行目と１１～１５行目を随時書き換えます。
コマンドプロンプトを起動し、プログラムを動かすカレントディレクトリに移動します。[Windowsの場合] cd C:\Users\username\conway [Linuxの場合] cd /home/username/conway
conway.pl 第１引数に3.を二重引用符で囲い、第２引数に4.を二重引用符で囲ったものを入力し、プログラムを起動します。[Windowsの場合] perl conway.pl "[[1,-2,3,-1,2,-3]]" "[1,1,1]" [Linuxの場合] conway.pl "[[1,-2,3,-1,2,-3]]" "[1,1,1]"

conway.plの内容

#!/usr/bin/perl

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

#require "/home/username/conway/crossing.pl";

#require "/home/username/conway/smoothing.pl";

###poly.plが格納されているディレクトリ(jonesかconway)のコメント(#)を外す;

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

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

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

require "C:/Users/username/conway/crossing.pl";

require "C:/Users/username/conway/smoothing.pl";

###poly.plが格納されているフォルダー(jonesかconway)のコメント(#)を外す;

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

#require "C:/Users/username/conway/poly.pl";

(my $link,my $sign) = splice(@ARGV, 0, 2);

&conway_main(eval $link, eval $sign);

sub conway_main {

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

print "link is ";

&print_matrix($link);

print "sign is ";

&print_matrix([$sign]);

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

if (@$poly1 == 0) {

$poly1 = eval "[[0]]";

}

print "conway polynomial is ";

&print_format($poly1);

}

sub say_all {

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

my ($k,$c,$d,$f,$h,$u,$i,$column,$z,$j,$g,$a,$b);

my (@columns,@vertex,@ver,@flag,@dust,@sign);

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

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

push (@columns,$column);

}

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

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

$f = ${${$link}[$c]}[$d];

push(@vertex,$f<0 ? -$f : $f);

}

@ver = sort { $a <=> $b; } @vertex;

@flag = (0)x ($ver[$#ver]);

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

for ($u=0; $u<$columns[$h]; $u++){

$i = ${${$link}[$h]}[$u];

$k = $i<0 ? -$i : $i;

push (@dust,$h,$u) if (!$flag[$k] && $i<0);

$flag[$k] = 1;

}

@sign = @{$sign};

&crossing_loop($link,scalar(@dust),@dust,@sign);

}

sub crossing_loop {

my ($link,$j) = splice(@_, 0, 2);

if ($j > 0 ){

my($x,$y,$orig,$new_link,$poly1,$poly2,$i,$nomal,$poly7);

my(@dust,@origsign,@new_sign,@sign);

($x,$y,@dust) = splice(@_, 0, $j);

@sign = @_;

$orig = &matrix_copy($link);

@origsign = @sign;

($new_link, @new_sign) = &crossing_number($link,$x,$y,@sign);

$poly1 = &crossing_loop($new_link,scalar(@dust),@dust,@new_sign);

($link, @sign) = &smoothing_number($link,$x,$y,@sign);

$poly2 = &say_all($link, [@sign]);

$i = ${${$new_link}[$x]}[$y];

if ($origsign[$i-1] == 1){

$poly7 = &poly_var_multiple($poly2,['z',1]);

$poly1 = &poly_plus($poly1,$poly7);

}elsif ($origsign[$i-1] == -1){

$poly8 = &poly_var_multiple($poly2,['z',1]);

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

$u = (-1) * ${$poly8}[$t][0];

splice(@{${$poly8}[$t]},0,1,$u);

}

$poly1 = &poly_plus($poly1,$poly8);

}

$poly1;

}else{

$nomal = @{$link};

if ($nomal <= 1){

[[1]];

}elsif ($nomal > 1){

[[0]];

}

sub matrix_copy {

my ($link) = @_;

my (@baz);

foreach (@{$link}) {

push(@baz, [@$_]);

}

[@baz];

}

1;

crossing.plの内容

#!/usr/bin/perl

#コンウエイ多項式の交差交換;

sub crossing_number {

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

my ($num,$column,$h,$j,$p,$q,$r);

my (@columns);

$link = &matrix_copy($link);

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

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

push (@columns,$column);

}

${${$link}[$chg1]}[$chg2] =~ s/^[\-]{1}(\d+)/$1/;

$k = $1;

$num = $k;

for ($h=$chg1; $h<@{$link}; $h++){

for ($j=0; $j<$columns[$h]; $j++){

$p = ${${$link}[$h]}[$j] if ($j != $chg2 | $h != $chg1);

$q = $p<0 ? -$p : $p;

if ($k == $q){

if ($p<0){

$r = $p;

}elsif ($p>0){

$r = -$p;

${${$link}[$h]}[$j] = $r

}

$sign[$num-1] = $sign[$num-1]*(-1);

($link, @sign);

}

1;

smoothing.plの内容

#!/usr/bin/perl

#コンウエイ多項式の分離;

sub smoothing_number {

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

my ($y,$foo4,$column,$columnl,$h,$i,$k,$p,$q,$r,$v,$x,$foo2,$num,$pach,$o,$j,$a,$c,$w,$e,$g,$dec);

my (@baz,@columns,@set1,@var,@set2,@set3,@set4,@set5,@set6);

$foo4 = &matrix_copy($link);

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

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

$columnl = @{${$link}[$k]};

push (@columns,$columnl);

}

$i = ${${$link}[$chg1]}[$chg2];

$k = $i<0 ? -$i : $i;

OUTER: for ($h=$chg2+1; $h<$column; $h++){

$p = ${${$link}[$chg1]}[$h];

$q = $p<0 ? -$p : $p;

push(@set1,$p) if ($p != $k);

if ($k == $q){

push(@var,\@set1);

last OUTER;

}

if ($h<$column){

for ($r = $h+1; $r<$column; $r++){

$v = ${${$link}[$chg1]}[$r];

push(@set2,$v);

}

for ($x = $0; $x<$chg2; $x++){

push(@set3,${${$link}[$chg1]}[$x]);

}

push(@var,[@set2,@set3]);

$foo2 = \@var;

splice(@{$foo4},$chg1,1,@{$foo2});

}else{

for ($y = 0; $y<$chg2; $y++){

push(@set4,${${$link}[$chg1]}[$y]);

}

INNER: for ($o=$chg1+1; $o<@{$link}; $o++){

for ($j=0; $j<$columns[$o]; $j++){

$a = ${${$link}[$o]}[$j];

$c = $a<0 ? -$a : $a;

if ($k == $c){

last INNER;

}

for ($w=$j+1; $w<$columns[$o]; $w++){

$e = ${${$link}[$o]}[$w];

push(@set5,$e);

}

for($g=0; $g<$j; $g++){

$dec = ${${$link}[$o]}[$g];

push(@set6,$dec);

}

push(@var,[@set1,@set4,@set5,@set6]);

$foo2 = \@var;

splice(@{$foo4},$o,1,@{$foo2});

splice(@{$foo4},$chg1,1);

}

$num = $k;

$pach = 0;

splice(@sign, $num-1, 1, $pach);

($foo4, @sign);

}

1;