#!/usr/bin/perl -w

use Math::Complex;

@wartosci_wlasne = wartosc_wlasna([[3, 4], [4, -3]]);  # Dwie rzeczywiste wartosci wlasne
print "Wartosci wlasne macierzy [[3, 4], [4, -3] to: @wartosci_wlasne\n";

@wartosci_wlasne = wartosc_wlasna([[1, -1], [2, 1]]);  # Dwie skomplikowane wartosci wlasne
print "Wartosci wlasne macierzy [[1, -1], [2, 1] to: @wartosci_wlasne\n";

@wartosci_wlasne = wartosc_wlasna([[1, -1, 0],[-1, 2, -1],[0, -1, 1]]);
print "[[1, -1, 0],[-1, 2, -1],[0, -1, 1]]: @wartosci_wlasne\n";

sub wartosc_wlasna {
    my $m = shift;
    my ($c1, $c2, $wyroznik);

    # macierz 1x1: jest wartoscia_wlasna jest element.
    return $m->[0][0] if @$m == 1;

    if (@$m == 2) {
        $wyroznik = ($m->[0][0] * $m->[0][0]) +
            ($m->[1][1] * $m->[1][1]) -
                (2 * $m->[0][0] * $m->[1][1]) +
                    (4 * $m->[0][1] * $m->[1][0]);
        $c1 = new Math::Complex;
        $c1 = sqrt($wyroznik);
        $c2 = -$c1;
        $c1 += $m->[0][0] + $m->[1][1];  $c1 /= 2;
        $c2 += $m->[0][0] + $m->[1][1];  $c2 /= 2;
        return ($c1, $c2);
    } elsif (@$m == 3) {
        use constant two_pi => 6.28318530717959;  # Potrzebne funkcji szescienne().
        my ($a, $b, $c, $d);
        $a = -1;
        $b = $m->[0][0] + $m->[1][1] + $m->[2][2];
        $c = $m->[0][1] * $m->[1][0] +
            $m->[0][2] * $m->[2][0] +
                $m->[1][2] * $m->[2][1] -
                    $m->[1][1] * $m->[2][2] -
                        $m->[0][0] * $m->[1][1] -
                            $m->[0][0] * $m->[2][2];
        $d = $m->[0][0] * $m->[1][1] * $m->[2][2] -
            $m->[0][0] * $m->[1][2] * $m->[2][1] +
                $m->[0][1] * $m->[1][2] * $m->[2][0] -
                    $m->[0][1] * $m->[1][0] * $m->[2][2] +
                        $m->[0][2] * $m->[1][0] * $m->[2][1] -
                            $m->[1][1] * $m->[0][2] * $m->[2][0];
        return szescienne($a, $b, $c, $d);   # Z rozdzialu 16, sekcja o rownaniach szesciennych
    }
    return;          # Nie policzymy wiekszych macierzy. Uzyjcie PDL!
}


sub szescienne {
    my ($a, $b, $c, $d) = @_;
    return quadratic($b, $c, $d) unless $a;
    ($a, $b, $c) = ($b / $a, $c / $a, $d / $a);
    my ($q) = ($a ** 2 - (3 * $b)) / 9;
    my ($r) = ((2 * ($a ** 3)) - (9 * $a * $b) + (27 * $c)) / 54;
    if (!ref($q) && !ref($r) && ($r ** 2) < ($q ** 3)) {
        my ($theta) = acos($r / ($q ** 1.5));
        my ($gain) = -2 * sqrt($q);
        my ($bias) = $a / 3;
        return ($gain * cos($theta / 3) - $bias,
                $gain * cos(($theta + two_pi) / 3) - $bias,
                $gain * cos(($theta - two_pi) / 3) - $bias);
    } else {
        my ($sgn) = 1;
        my ($tmp) = sqrt($r ** 2 - $q ** 3);
        my ($rconj) = $r;
        ref($rconj) && ($rconj = ~$rconj);
        $rconj *= $tmp;
        $sgn = -1 if (ref($rconj) && $rconj->Re < 0) or $rconj < 0;
        $s = Math::Complex->new($sgn, 0);
        $s = $s * $tmp + $r;
        $s **= 1/3;
        $s = -$s;
        $t = ($s ? ($q / $s) : 0);
        return ($s + $t - $a / 3,
                -0.5 * ($s+$t) + sqrt(-1) * sqrt(3)/2 * ($s-$t) - ($a/3),
                -0.5 * ($s+$t) - sqrt(-1) * sqrt(3)/2 * ($s-$t) - ($a/3));
    }
}
