Kanako's Programming

perl編（ゲーリッツ不変量の計算）

#!/usr/bin/perl

use POSIX;

sub goeritz_main {
    my ($cgi_arr) = @_;

    my @arr = ();
    my @arr2 = ();
    @arr = split(/:/,$cgi_arr);
    foreach (@arr) {
	my @arr1 = ();
	@arr1 = split(/,/,$_);
	push(@arr2,\@arr1);
    }
    my $arr3;
    $arr3 = [@arr2];

##1行1列目の削除;
    my @arr4 = ();
    for (my $i=1; $i<@$arr3; ++$i) {
	push(@arr4,[@{$$arr3[$i]}[1..@{$$arr3[$i]}-1]]);
    }
    my $matrix = [@arr4];

    for (my $start=0; $start<@$matrix; ++$start) {
	&goeritz_part1_line_row($matrix,$start);
    }
    my @new_list;
    @new_list = &goeritz_part3($matrix);


    foreach (@new_list) {
	if ($_ != 1) {
	    my $t = @new_list;
	    if ($t == 1) {

	    }else {
		if ($t > 1) {
		    for(my $n=0; $n < $t; ++$n) {
			if ($new_list[$n] != 1) {
			    print "$new_list[$n]";
			    if ($t > $n+1) {
				print "+";
			    }
			}
		    }
		    print "\n";
		}else {
		    print "$new_list[0]\n";
		}
	    }
	}
    }
    exit;
}

sub goeritz_part1_line_row {
    my ($matrix,$start) = @_;

    my $d=-1;
    my $i0 = $start;
    my $j0 = $start;
    my $e;

    for (;;) {
	$e = abs $matrix->[$start]->[$start];
	for(my $i=$start; $i<@$matrix; ++$i) {
	    for (my $j=$start; $j<@{$matrix-<[$i]}; ++$j) {
		if ($e == 0 || (($e > abs $matrix->[$i]->[$j]) && ($matrix->[$i]->[$j] != 0))) {
		    $e = abs $matrix->[$i]->[$j];
		    $i0 = $i;
		    $j0 = $j;
		}
	    }
	}

	if ($e == 0 || $e == $d) {
	    last;
	}
	$d = $e;

	if ($matrix->[$i0]->[$j0] < 0) {
	    for (my $j5=$start; $j5<@{$matrix->[$i0]}; ++$j5) {
		$matrix->[$i0]->[$j5] = -$matrix->[$i0]->[$j5];
	    }
	}

##基本変形;
	my ($g,$n);
	for (my $j1=$start; $j1 <@{$matrix->[$i0]}; ++$j1) {
	    if ($j1 == $j0) {

	    }else {

		$g = $matrix->[$i0]->[$j1]/$matrix->[$i0]->[$j0];

		for (my $i2=$start; $i2<@$matrix; ++$i2) {
		    $n = $matrix->[$i2]->[$j1]-$matrix->[$i2]->[$j0]*floor($g);

		    $matrix->[$i2]->[$j1] = $n;
		}
	    }
	}

	my ($g0,$n0);
	for (my $i3=$start; $i3 < @$matrix; ++$i3) {
	    if ($i3  == $i0) { 
	    }else {
		
		$g0 = $matrix->[$i3]->[$j0]/$matrix->[$i0]->[$j0];

		for (my $j2=$start; $j2 < @{$matrix->[$i0]}; ++$j2) {
		    $n0 = $matrix->[$i3]->[$j2]-$matrix->[$i0]->[$j2]*floor($g0);
		    $matrix->[$i3]->[$j2] = $n0;
		}
	    }
	}


	for (my $j2=$start; $j2 < @{$matrix->[$start]}; ++$j2) {
	    my $x = $matrix->[$start]->[$j2];
	    $matrix->[$start]->[$j2] = $matrix->[$i0]->[$j2];
	    $matrix->[$i0]->[$j2] = $x;
	}

	for (my $i2=$start; $i2 < @$matrix; ++$i2) {
	    my $y = $matrix->[$i2]->[$start];
	    $matrix->[$i2]->[$start] = $matrix->[$i2]->[$j0];
	    $matrix->[$i2]->[$j0] = $y;
	}
    }
    return $matrix;
}

sub goeritz_part3 {
    my ($matrix) = @_;

    my @list_matrix =();
    for (my $i = 0; $i < @$matrix; ++$i) {
	push(@list_matrix,abs $$matrix[$i][$i]);
    }
    return @list_matrix;
}