<< DiscreteMath`Combinatorica`

Off[General::spell1];
Off[Star::shdw];

<<Graphics`MultipleListPlot`

A stabilitás feltételei

Reakciógráfokhoz rendelt mátrixok sajátértékeinek vizsgálata a csúcs- és élszám függvényében

Készítette: 
Dömötör Erika
BME-TTK, matematikus szak, 2. évfolyam

2007. május

1. Bevezetés

Ez a dolgozat kémiai reakciók stabilitását elemzi a reakciógráfok alapján felírt mátrixok segítségével. Egy rendszer stabilitása a rendszer méretétől és bonyolultságától függhet. A reakciókhoz rendelt gráfokban a méretet a csúcsok száma, a bonyolultságot az élek száma jellemzi leginkább, a stabilitást a mátrix sajátértékeinek valós része alapján vizsgálhatjuk. Az alábbi pontokban először megkonstruáljuk egy tetszőleges gráf mátrixát, és meghatározzuk a sajátértékek valós részét, majd véletlen gráfok sorozatára alkalmazva az eljárást vizsgáljuk a sajátértékek maximumának és minimumának lehetséges értékeit a gráf tulajdonságainak (csúcsszám, él behúzásának valószínűsége) függvényében.

2. Modellezés

A gráfhoz felírt mátrix és sajátértékei

A reakciókat irányított gráfok írják le. Egy adott n pontú gráfhoz egy n×n-es mátrixot írunk fel: ha a gráfban a j-edik pontból az i-edikbe mutat él, akkor a j-edik oszlop i-edik sorában legyen (Subscript[k, i j ]), a j-edik oszlop j-edik sorában -(Subscript[k, i j]). A mátrix főátlójába több érték is kerülhet, ezek összeadódnak.

Egy példa

Vegyünk egy gráfot.

ShowGraph[g = FromOrderedPairs[{{1, 4}, {2, 4}, {2, 3}, {3, 4}}], 
        VertexNumber -> True, EdgeDirection -> True];

Mátrixa a következő:

MatrixForm[
      K = {{-(Subscript[k, 41]), 0, 0, 0}, {0, -(Subscript[k, 42]) - (Subscript[k, 32]), 0, 0}, {0, 
            (Subscript[k, 32]), -(Subscript[k, 43]), 0}, {(Subscript[k, 41]), (Subscript[k, 42]), (Subscript[k, 43]), 0}}]

A mátrix sajátértékeinek valós része (Subscript[k, i j]) = 1 esetén:

Re[Eigenvalues[K /. {(Subscript[k, _ ]) -> 1}]]

Konstrukció tetszőleges gráfra

A matrix[n][p] függvény egy n és p paraméterű véletlen gráfra felírja a hozzá rendelt mátrixot.

m0[n_][p_] := 
      SparseArray[{{i_, j_} /; 
              MemberQ[ToOrderedPairs[ H = RandomGraph[n, p, Directed]], {j, 
                  i}] -> k[i][j], {i_, i_} /; 
              MemberQ[l, {j, i}] -> -k[i][j]}, {n, 
          n}]

m[s_][n_][p_] := 
      SparseArray[{j_, j_} /; 
            MemberQ[ToOrderedPairs[ H = RandomGraph[n, p, Directed]], {j, 
                s}] -> -k[s][j], {n, n}]

matrix[n_][p_] := m0[n][p] + 
        Sum[m[j][n][p], {j, 1, n}]

Például (legyen minden (Subscript[k, ij])=1):

k[i_][j_] := 1. 
matrix[4][0.5] // MatrixForm

Meghatározzuk egy n, p paraméterű véletlen gráf sajátértékeinek valós részeit. A 0 sajátértékeket elhagyjuk a listából.

valosresz[n_][p_] := 
      DeleteCases[
        DeleteCases[
          Chop[Re[Eigenvalues[matrix[n][p]]], 10^(-10)], 0], 
        0. ]

Például:

valosresz[4][0.5]

Sajátértékek listája

A sajátértékeket több azonos tulajdonságú (adott n és p) véletlen gráfra szeretnénk vizsgálni. Ehhez listát készítünk d darab n és p paraméterű  gráf sajátértékeiről.

valosreszlista[n_][p_][d_] := 
      Table[valosresz[n][p], {i, d}]

Például az 5 tagú lista n=4,  p=0.5-re:

valosreszlista[4][0.5][5]

Ez a lista kisebb listákból áll, így nehéz az elemeit összehasonlítani. Vegyünk két újabb listát: az egyikben a gráfok legkisebb (minlista), a másikban a legnagyobb (maxlista) sajátértékei szerepeljenek.

minlista[n_][p_][d_] := 
      Min /@ valosreszlista[n][p][d] /. {k[i_][j_] -> 
            1. }

maxlista[n_][p_][d_] := 
      Max /@ valosreszlista[n][p][d] /. {k[i_][j_] -> 
            1. }

Például:

minlista[4][0.5][5] /. {Infinity -> 0}

maxlista[4][0.5][5] /. {-Infinity -> 0}

3. Kísérletek

Most vizsgáljuk az előbbi listákat n és p változtatásával.

Bonyolultság

Legyen először n=4 rögzített, p pedig 0.15, 0.3, 0.5, 0.7 és 0.85.
A kapott listákat grafikonon szemléltetjük.

min[
        1] = minlista[4][0.15][
          50] /. {Infinity -> 0}
max[
        1] = maxlista[4][0.15][
          50] /. {-Infinity -> 0}

Show[
      GraphicsArray[{ListPlot[min[1], PlotStyle -> PointSize[0.015], 
            DisplayFunction -> Identity, 
            PlotLabel -> "Minimum p=0.15-re"], 
          ListPlot[max[1], PlotStyle -> PointSize[0.015], 
            DisplayFunction -> Identity, 
            PlotLabel -> "Maximum p=0.15-re"]}], 
      ImageSize -> 400]

min[
        2] = minlista[4][0.3][
          50] /. {Infinity -> 0}
max[
        2] = maxlista[4][0.3][
          50] /. {-Infinity -> 0}

Show[
      GraphicsArray[{ListPlot[min[2], PlotStyle -> PointSize[0.015], 
            DisplayFunction -> Identity, 
            PlotLabel -> "Minimum p=0.3-ra"], 
          ListPlot[max[2], PlotStyle -> PointSize[0.015], 
            DisplayFunction -> Identity, 
            PlotLabel -> "Maximum p=0.3-ra"]}], 
      ImageSize -> 400]

min[3] = minlista[4][0.5][50]
max[3] = maxlista[4][0.5][50]

Show[
      GraphicsArray[{ListPlot[min[3], PlotStyle -> PointSize[0.015], 
            DisplayFunction -> Identity, 
            PlotLabel -> "Minimum p=0.5-re"], 
          ListPlot[max[3], PlotStyle -> PointSize[0.015], 
            DisplayFunction -> Identity, 
            PlotLabel -> "Maximum p=0.5-re"]}], 
      ImageSize -> 400]

min[4] = minlista[4][0.7][50]
max[4] = maxlista[4][0.7][50]

Show[
      GraphicsArray[{ListPlot[min[4], PlotStyle -> PointSize[0.015], 
            DisplayFunction -> Identity, 
            PlotLabel -> "Minimum p=0.7-re"], 
          ListPlot[max[4], PlotStyle -> PointSize[0.015], 
            DisplayFunction -> Identity, 
            PlotLabel -> "Maximum p=0.7-re"]}], 
      ImageSize -> 400]

min[5] = minlista[4][0.85][50]
max[5] = maxlista[4][0.85][50]

Show[
      GraphicsArray[{ListPlot[min[5], PlotStyle -> PointSize[0.015], 
            DisplayFunction -> Identity, 
            PlotLabel -> "Minimum p=0.85-re"], 
          ListPlot[max[5], PlotStyle -> PointSize[0.015], 
            DisplayFunction -> Identity, 
            PlotLabel -> "Maximum p=0.85-re"]}], 
      ImageSize -> 400]

Méret

Most változtassuk a gráf méretét. Legyen p=0.5 rögzített, n pedig 4, 6, 8, 10 és 12.

min[6] = minlista[4][0.5][50]
max[6] = maxlista[4][0.5][50]

Show[
      GraphicsArray[{ListPlot[min[6], PlotStyle -> PointSize[0.015], 
            DisplayFunction -> Identity, 
            PlotLabel -> "Minimum n=4-re"], 
          ListPlot[max[6], PlotStyle -> PointSize[0.015], 
            DisplayFunction -> Identity, 
            PlotLabel -> "Maximum n=4-re"]}], 
      ImageSize -> 400]

min[7] = minlista[6][0.5][50]
max[7] = maxlista[6][0.5][50]

Show[
      GraphicsArray[{ListPlot[min[7], PlotStyle -> PointSize[0.015], 
            DisplayFunction -> Identity, 
            PlotLabel -> "Minimum n=6-ra"], 
          ListPlot[max[7], PlotStyle -> PointSize[0.015], 
            DisplayFunction -> Identity, 
            PlotLabel -> "Maximum n=6-ra"]}], 
      ImageSize -> 400]

min[8] = minlista[8][0.5][50]
max[8] = maxlista[8][0.5][50]

Show[
      GraphicsArray[{ListPlot[min[8], PlotStyle -> PointSize[0.015], 
            DisplayFunction -> Identity, 
            PlotLabel -> "Minimum n=8-ra"], 
          ListPlot[max[8], PlotStyle -> PointSize[0.015], 
            DisplayFunction -> Identity, 
            PlotLabel -> "Maximum n=8-ra"]}], 
      ImageSize -> 400]

min[9] = minlista[10][0.5][50]
max[9] = maxlista[10][0.5][50]

Show[
      GraphicsArray[{ListPlot[min[9], PlotStyle -> PointSize[0.015], 
            DisplayFunction -> Identity, 
            PlotLabel -> "Minimum n=10-re"], 
          ListPlot[max[9], PlotStyle -> PointSize[0.015], 
            DisplayFunction -> Identity, 
            PlotLabel -> "Maximum n=10-re"]}], 
      ImageSize -> 400]

min[10] = minlista[12][0.5][50]
max[10] = maxlista[12][0.5][50]

Show[
      GraphicsArray[{ListPlot[min[10], PlotStyle -> PointSize[0.015], 
            DisplayFunction -> Identity, 
            PlotLabel -> "Minimum n=12-re"], 
          ListPlot[max[10], PlotStyle -> PointSize[0.015], 
            DisplayFunction -> Identity, 
            PlotLabel -> "Maximum n=12-re"]}], 
      ImageSize -> 400]

Listák összehasonlítása

További összehasonlításhoz a minimumok és maximumok listáit közös grafikonban is ábrázolhatjuk.

Show[
      GraphicsArray[{MultipleListPlot[min[1], min[2], min[3], min[4], min[5], 
            SymbolStyle -> {Hue[0.1], Hue[0.3], Hue[0.5], Hue[0.7], 
                Hue[0.9]}, DisplayFunction -> Identity, 
            PlotLabel -> "Minimum p \
függvényében"], 
          MultipleListPlot[max[1], max[2], max[3], max[4], max[5], 
            SymbolStyle -> {Hue[0.1], Hue[0.3], Hue[0.5], Hue[0.7], 
                Hue[0.9]}, DisplayFunction -> Identity, 
            PlotLabel -> "Maximum p \
függvényében"]}], 
      ImageSize -> 400]

Show[
      GraphicsArray[{MultipleListPlot[min[6], min[7], min[8], min[9], 
            min[10], 
            SymbolStyle -> {Hue[0.1], Hue[0.3], Hue[0.5], Hue[0.7], 
                Hue[0.9]}, DisplayFunction -> Identity, 
            PlotLabel -> "Minimum n \
függvényében"], 
          MultipleListPlot[max[6], max[7], max[8], max[9], max[10], 
            SymbolStyle -> {Hue[0.1], Hue[0.3], Hue[0.5], Hue[0.7], 
                Hue[0.9]}, DisplayFunction -> Identity, 
            PlotLabel -> "Maximum n \
függvényében"]}], 
      ImageSize -> 400]

A minimum sosem lesz pozitív érték, a maximum viszont pozitív és negatív értékeket is felvehet. Vizsgálhatjuk, hogy p-től és n-től függően milyen ezeknek az értékeknek az aránya. A listákban szereplő pozitív és nem pozitív értékek számát szemléltetjük.

poz = Table[Length[Select[max[i], Positive]], {i, 5}]

neg = Table[Length[Select[max[i], Negative]], {i, 5}]

poz2 = Table[Length[Select[max[i], Positive]], {i, 6, 10}]

neg2 = Table[Length[Select[max[i], Negative]], {i, 6, 10}]

\(Show[
      GraphicsArray[{MultipleListPlot[neg, poz, 
            SymbolStyle -> {Hue[0.3], Hue[0.8]}, 
            PlotJoined -> True, DisplayFunction -> Identity, 
            AxesOrigin -> {0, 0}, 
            Ticks -> {{{1, "p=0.15"}, {2, "p=0.3"}, {3, "p=0.5"}, {4, "p=0.7"}, {5, "p=0.85"}}, Automatic}, 
            PlotLabel -> "Pozitív és nem pozitív maximumok p függvényében"], 
          MultipleListPlot[neg2, poz2, 
            SymbolStyle -> {Hue[0.3], Hue[0.8]}, 
            PlotJoined -> True, DisplayFunction -> Identity, 
            AxesOrigin -> {0, 10}, 
            Ticks -> {{{1, "n=4"}, {2, "n=6"}, {3, "n=8"}, {4, "n=10"}, {5, "n=12"}}, Automatic}, 
            PlotLabel -> "Pozitív és nem pozitív maximumok n függvényében"]}], 
      ImageSize -> 600]\)

4. Összegzés

A reakciógráfokhoz rendelt mátrixok és az ezekből kapott listák segítségével többféle szempontból vizsgálhatjuk a sajátértékeket különböző tulajdonságú gráfokra, amelyek különböző méretű és bonyolultságú rendszereket írnak le. A fenti módszer bármely p valószínűségre jól működik, n nagy értékeire viszont lassúvá válik, mivel n×n-es mátrixok sajátértékét kell kiszámolni.

Felhasznált irodalom:
 Érdi Péter, Tóth János: What is and what is not stated by the May-Wigner theorem?, J. theor. Biol. 145 (1990), 137–140.