Svojstveni problem

07.03  .2006.

<< Graphics`ImplicitPlot`
<< Graphics`Graphics`

Kontrakcija - dilatacija

al = 1/2; be = 1/3; A = {{al, 0}, {0, be}};
sl1 = 
        ImplicitPlot[{x1^2 + x2^2 == 1, 
            x1^2/al^2 + x2^2/be^2 == 1}, {x1, -3, 3}, 
          DisplayFunction -> Identity];
P1 = {1, 1}; P2 = {-1, 1}; P3 = {-1, -1}; 
    P4 = {1, -1};
{P1, P2, P3, P4, P1};
{P1, P2, P3, P4, P1} . A;
sl2 = 
        Show[Graphics[{Point[{0, 0}], Line[{P1, P2, P3, P4, P1}], 
              Line[{P1, P2, P3, P4, P1} . A]}], Frame -> False, 
          Axes -> True, Ticks -> Automatic, 
          AspectRatio -> Automatic,  
          DisplayFunction -> Identity];
Show[GraphicsArray[{sl1, sl2}], 
        DisplayFunction -> $DisplayFunction];

Primjer 1: simetricni linearni operator

A = {{2, 1}, {1, 2}} ;

    K1[x1_, 
        y1_] = (Inverse[A][[1]] . {x1, 
                  y1})^2 + (Inverse[A][[2]] . {x1, 
                  y1})^2 == 1

    ImplicitPlot[{x1^2 + y1^2 == 1, K1[x1, y1]}, {x1, -3, 
          3}];

Primjer 2: veza

eigen = Eigensystem[A]
V = Sqrt[2] eigen[[2]]/2
Transpose[V] . DiagonalMatrix[eigen[[1]]] . V

A = DiagonalMatrix[eigen[[1]]]
K1[x1_, 
        y1_] = (Inverse[A][[1]] . {x1, 
                  y1})^2 + (Inverse[A][[2]] . {x1, 
                  y1})^2 == 1
ImplicitPlot[{x1^2 + y1^2 == 1, K1[x1, y1]}, {x1, -3, 
          3}];

Primjer 3: definitnost

definitnost[alfa_, beta_, n_] := 
      Module[{ind = psd = nsd = 0}, 
Do[
          a1 = Table[
              Random[Real, {alfa, beta}], {i, 2}, {j, 
                2}]; 
a = 
            a1 + Transpose[a1]; 
svvr = 
            Eigenvalues[a]; 
l1 = svvr[[1]]; 
          l2 = svvr[[2]]; 
If[
            l1 ≥  0 && l2 ≥  0, 
            psd = psd + 1, 
If[
              l1 ≤  0 && l2 ≤  0, nsd = nsd + 1, 
              ind = ind + 1]], {k, n}]; 
x = {PSD, IND, 
            NSD}; 
freq = {psd, ind, 
            nsd}; 
bar = 
          BarChart[Transpose[{freq, x}], PlotRange ->  {0, n}, 
            DisplayFunction -> Identity]]

sl1 = definitnost[-10, 0, 5000]
sl2 = definitnost[-10, 10, 5000];
sl3 = definitnost[0, 10, 5000];
Show[GraphicsArray[{sl1, sl2, sl3}]];