Móra Péter: Egy adott szám elérése véletlenszerű dobások összegeként, és gráfok véletlenszerű bejárása

1. Egy adott szám elérése véletlenszerű dobások összegeként

1.1 Bevezetés

Rögzítsünk egy n számot. Felmerülhet a kérdés, hogy mennyi a valószínűsége, hogy egy szabályos d oldalú dobókockákkal dobva a dobások összegeként előálljon ez az n szám. Például egyes társasjátékokban pontosan akkor nyerünk, ha az utolsó mezőre rálépünk, ha nem, akkor újra kell kezdenünk a játékot. Azt is kérdezhetjük, hogy ha van egy (nem feltétlenül) szábályos d oldalú dobókockánk és a dobások összegeként előállítandó n-nel tartatunk a végtelenbe, akkor ez a valószínűség konvergál-e valahova, és ha igen, akkor mi lesz a határérték.
	A dolgozatom első részében próbálok minnél részletesebb választ adni ezekre a kérdésekre. Igyekeztem több oldalról megközelíteni a problémát. Látni fogjuk, hogy mindegyik megközelítés hasznos valamelyik bizonyításban, vagy legalábbis szép valamilyen szempontból.

1.2. A probléma megközelítése algoritmikusan, az alapötlet

Bevezetés: Annak a valószínűsége, hogy előáll n véletlen dobások összegeként könnyen kiszámolható, ha tudjuk ezt a valószínűséget n-1, n-2, ... n-d-re. Szabályos kocka esetén ha ezeket az értékeket átlagoljuk, akkor pont az n-hez tartozó értéket kapjuk meg. Ez azért igaz, mert n-et pont ezekről a helyekről lehet elérni, és mindegyik helyről (1/d) valószínűséggel.

Algoritmus: Egy listát fogunk elkészíteni. A listánál a k. eleménél található érték azzal a valószínűséggel lesz egyenlő, amekkora a valószínűsége annak, hogy pontosan k-t dobunk ki kockadobások összegeként. A listát folyamatosan fogjuk feltölteni. A k-dik elem a k-d, k-(d+1), ... k-1 helyen lévő elemek összegének d-ed része lesz. Természetesen ha az első d-1 elemre nem létezik előző d db elem, ezért figyelni kell arra, hogy mely értékeket adunk össze. Ha k-val elértük n-et, akkor adjuk vissza a lista n-edik értékét. Kezdéskor legyen a lista 0. eleme 1, mivel a 0-át elérhetjük úgy, hogy nem dobunk. Mivel a Mathematica egytől kezdi a lista elemeinek a sorszámát, ezért használjunk indexeltolást.

ReachWithSum1[n_, 
        d_] := 
Fold[
Module[{k = #1}, 
              k[[#2]] = 
                Total[Drop[Take[#1, #2 - 1], Max[#2 - d - 1, 0]]]/d; 
              k] &, 
Range[n + 1], 
          Range[n] + 1][[
        n + 1]]

ReachWithSum1[100, 6]

Kevesebb memória foglalással is megoldható a feladat, ha egy picit átírjuk az algoritmust. Vegyük észre, hogy csak az utolsó d elem értéke számít. Eddig folytonosan egy listában vezettük ezen értékeket, most tároljuk el csak a legutolsó d elemet egy listában, és vegyük a listabeli címzéseket mod d. Kezdetkor a d. elem legyen 1, a többi 0. Ez jelképezi majd azt, hogy a 0-át biztosan elérjük. Az elem kiszámolásához vennünk kellett az előző d elem d-edrészének összegét. Ez most pont azt jelenti, hogy átlagolnunk kell a listaelemeket.
	Az alábbi algorimus az első algoritmussal ekvivalens.

ReachWithSum2[n_, 
        d_] := 
Nest[{Module[{k = #[[1]]}, 
                k[[#[[2]]]] = 
                  Mean[#[[1]]]; k], 
              Mod[#[[2]] + 1, d, 
                1]} &, {Array[KroneckerDelta[#, d] &, d], 1}, 
          n][[1, 
        Mod[n, d, 1]]]

ReachWithSum2[100, 6]

Összefoglalhatjuk egy eljárássá a fenti két módszert, így egy paraméter segítségével opcionálisan megmondhatjuk, hogy melyik algoritmus fusson le. Alapértelmezésben fusson mindig a gyorsabb algoritmus, hiszen az is ugyanolyan pontos.

Options[ReachWithSum] = {FastMethod -> True};

ReachWithSum[n_, d_, opc___?OptionQ] := 
      If[FastMethod /. {opc} /. Options[ReachWithSum], 
        ReachWithSum2[n, d], ReachWithSum1[n, d]]

Ez az eljárás még tovább gyorsítható lenne, ha az átlagot mindig eltárolnánk, és az adott érték felülírásakor módosítatnánk, de ez már csak technikai finomítás lenne.
	n=100-ra ez a szimuláció által visszaadott érték első 14 tizedesjegye megegyezik (1/3.5)-tel. Mivel egy dobás várható értéke 3.5, ebből az sejthető, hogy a várható érték reciprokához fog konvergálni ez az érték, ha n tart végtelenhez.

ReachWithSum[100, 6]

N[%, 15]

N[(2/7), 15]

ListPlot[Table[{n, ReachWithSum2[n, 6]}, {n, 100}], 
      PlotStyle -> {PointSize[0.01], Hue[0.6]}, PlotRange -> All, 
      PlotJoined -> True, 
      AxesLabel -> 
        TraditionalForm /@ {n, "ReachWithSum2[n,6]"}]

Összegzés: Az itt leírt algoritmust azért ismertettem, mert úgy gondolom ez a legkézenfekvőbb megközelítése a feladatnak.

1.3. A probléma megközelítése algoritmikusan, egy másik szemszögből

Algoritmus: Egy listát fogunk kezelni, amelynél kezdetben az első d helyen (1/d) áll, az összes többi helyen 0. k kezdetben legyen egyenlő 1-gyel.
A következőekben indukciót fogunk alkalmazni. A k-dik lépés után a lista i. helyén szereplő érték azt fogja megmutatni, hogy mekkora esély lenne arra, hogy pontosan i-t dobjunk ki összegként, ha a játékot úgy játszanánk, hogy addig dobunk, amíg a dobott összeg el nem éri k-t. k=1-re ez teljesül, mivel ekkor pontosan egyszer kell dobnunk, hogy az összeg legalább 1 legyen, és az első d helyen (1/d) áll.
	Egy lépés során k-ról k+1-re lépünk. Az eddigi tábla azon esetek elosztását mutatja, ahol megálltunk, amikor a dobások összege legalább k. Most azonban azt az esetet szeretnénk, amikor akkor állunk meg, amikor a dobások összege legalább k+1. Abban az esetben, amikor pontosan k-t dobunk újra dobnunk kell. A k-nál nagyobb elemeket eddig nem érhettük el közvetlenül k-ból, ezért a függetlenség miatt a k+1, k+2, k+3, ... k+d elemekhez hozzáadhatjuk a k. helyen lévő érték d-ed részét. Növeljük k-t eggyel.
	Ha k-val elértük n-et, akkor álljunk meg, és olvassuk le az n-edik helyen lévő értéket.

ReachWithSum3[n_, 
        d_] := Fold[
          Module[{l = #1}, 
              l[[Range[d] + #2]] += 
                l[[#2]]/d; l] &, 
          Array[UnitStep[d - #]/d &, n + d], 
          Range[n - 1]][[
        n]]

Kevesebb memóriafoglalással is megoldható a feladat, ha csak két d+1  hosszú listának foglalunk helyet, és azzal ügyeskedünk, továbbá nagyságrendekkel való gyorsítás érhető el, ha lebegőpontos értékekkel számolnánk.

ReachWithSum4[n_, 
        d_] := 
Nest[
          Module[{l = #1}, 
              l += l[[1]] Array[
                    UnitStep[# - 1]/d &, d + 1]; 
              l[[1]] = 0; 
              RotateLeft[l, 1]] &, Array[UnitStep[d - #]/d &, d + 1], 
          n - 1][[1]]

Összegzés: Ez a megközelítés nem adja magát rögtön, de mint látni fogjuk hasznos, innen könnyen ki fog jönni a konvergencia szabályos kockára, és a lehetséges határérték tetszőleges kockára.

1.4. A probléma megközelítése rekurzióval

A fenti módszer lényege rekurzióval leírható. Szabályos kocka esetén a rekurziós képlet (Subscript[p, k + d]) = ((Subscript[p, k]) + (Subscript[p, k + 1]) + 
                  (Subscript[p, k + 2]) +  ...  + (Subscript[p, k + d - 1]))/d, (Subscript[p, 0]) = 1,  
      (Subscript[p, -1]) = (Subscript[p, -2]) =.  ..  = (Subscript[p, -d + 1]) = 0 kezdeti értékekkel, hiszen a (k+d). számot épp a k., (k+1)., (k+2)., ... (k+d-1). helyről lehet elérni, mindenhonnan (1/d) valószínűséggel. A 0 értéket 1 valószínűséggel el lehet érni (hiszen ez előáll még az első dobás előtt), továbbá a kényelem kedvéért kiterjeszthető ez a sor negatív tagokra is úgy, hogy ott 0-ák legyenek.
 	Ez egy lineráris állandó együtthatós homogén egyenletrendszer, amire tanultunk megoldást Kombinuatórika és Gráfelmélet, továbbá Feladatmegoldó Szerminárium című órákon. Meg kell keresni azon mértani sorokat, amelyek kiegészítik ezt a feltételt, azaz megoldásaik a következő polinomnak:

(∑_(i = 1)^(d - 1))((x^i)/d) == (x^d);

Amennyiben ennek a polinomnak vannak töbszörös gyökei, pl. w m-szeres gyöke, akkor megmutatható, hogy w, nw, (n^2) 
        w,  ... (n^(m - 1)) w is kielégíti a rekurziós képletet. Így mindenképp kapunk d db lineárisan független sorozatot, amelyek lineáris kombinációjával előállítható az első adott d elem, így adható egy zárt képlet a sorozat tetszőleges elemére.
	A Mathematicában ezt az előállítást határozza meg az RSolve nevű eljárás. Például d=3 esetén:

RSolve[{f[k + 3] == (1/3) (∑_(i = 0)^2) f[k + i], 
          f[0] == 1, f[-1] == 0, f[-2] == 0}, f[k], 
        k] // Simplify

A módszer problémája az, hogy d oldalú kocka esetén meg kell keresni egy d-edfokú egyenlet gyökeit. Ha d≥5, akkor nem létezik általános megoldóképlet. Segítség, hogy a Mathematica képes a gyökök közelítéssel való meghatározására. Például d=6 esetre az álltalános képletet számolása közelítőleg:

rs = 
      N[RSolve[{f[k + 6] == (1/6) (∑_(i = 0)^5) f[k + i]}, 
          f[k], k], 20]

Már csak el kell találnunk a jó C[i] együtthatókat, hogy azok kiadják az első pár tagot. Ehhez használjuk az előző trükköt, a 0. elem legyen 1, a -d+1. elemtől -1-ig pedig legyenek 0-ák az elemek.

s = 
      Solve[Table[
          rs[[1, 1, 2]] == 
            If[k == 0, 1, 0], {k, -5, 0}], {C[1], C[2], C[3], C[4], 
          C[5], C[6]}]

rs[[1, 1, 2]] /. s // 
      Chop

% /. {k -> 100} // Chop

Emlékeztetőül pont ezt az értéket számoltuk eddig is:

N[ReachWithSum[100, 6], 18]

Összegzés: A módszer szépsége, hogy egy előre megírt Mathematicai függvényt használ, a továbbiakban részletezett módon lehetőséget ad a konvergencia bizonyítására, és könnyen általánosítható hamis kockára is. Hátránya, hogy legalább 5 oldalú kocka esetén nem ad pontos értéket.

1.5. A konvergencia bizonyítása szabályos kocka esetén

Az előzőeknél számoltakból jól látható, hogy d=6 esetén a rekurziós képletben minden tag, amit a k-dik hatványra emelünk 1-nél kisebb abszolút értékű. Ha k->∞, akkor az általános képletben minden a konstanstól különböző tag tartani fog 0-hoz, így létezik határték. Az alábbiakban azt fogjuk megmutatni, hogy ez minden d-re teljesül. 
	A fentiek alapján ezek a sorozatok előállnak (Subscript[w, i]) és ((Subscript[nw, i])^n)alakú kifejezések lineáris kombinációjaként, ahol (Subscript[w, i]) a következő egyenlet gyöke:

(1/d) (∑_(i = 0)^(d - 1))(x^i) == 
        (x^d);

Szorozzuk meg mindkét oldalt d-vel:

(∑_(i = 0)^(d - 1))(x^i) == d (x^d);

Ennek az egyenletnek az 1 mindig gyöke. Be fogjuk látni, hogy az összes többi gyök 1-nél kisebb abszolút értékű, így a rekurziós képletben az (1^k) együtthatója lesz a határérték.
	Vegyük mindkét oldalt abszolút értéket. Háromszög egyenlőtlenséget használva:

d Abs[(x^d)] == 
        Abs[(∑_(i = 0)^(d - 1))(x^i)] ≤ (∑_(i = 0)^(d - 1))Abs[x]^i;

Pontosan akkor áll egyenlőség, ha az (x^i) argumentuma ugyanannyi minden i-re, de az Abs[x]^0 == 1 argumentuma 0, így pontosan akkor áll egyenlőség, ha mindegyik (x^i) pozitív valós. Ha Abs[x] == 1, akkor ebből következik, hogy x == 1, különben

d < (∑_(i = 0)^(d - 1))(1^i)

Ami ellentmondás.
	Tegyük fel, hogy létezik 1-nél nagyobb abszolútértékű gyök. Ekkor

d Abs[x]^d == 
        Abs[(∑_(i = 0)^(d - 1))(x^i)] ≤ (∑_(i = 0)^(d - 1))Abs[x]^i < (∑_(i = 0)^(d - 1))Abs[x]^d == 
        d Abs[x]^d;

Ez pedig ellentmondás.A szigorú egyenlőtlenség könnyen meggondolható, például a szummában 1-et Abs[x]^d-re cseréltük, ami 1-nél nagyobb.

Összegzés: Beláttuk, hogy szabályos kocka esetén mindig konvergens lesz a sorozat.

1.6. Határérték meghatározása

A határértéket az 1.2-es pontban részletezett eljárás segítségével fogjuk levezetni. 
	Határérték szabályos kocára: Tegyük fel, hogy létezik x határérték. Akkor a határértékre teljesülnie kell a következő egyenletnek:
	x + (x - (1/d) x) + (x - (2/d) 
                    x) +  ...  + (x - ((d - 1)/d) x) = 1
	Magyarázat: Amikor az eljárás a k. értékhez érkezik, akkor a feltétel szerint (miszerint létezik határérték), ott x áll. A k+1. helyen azért kell  x - (1/d) x-nek állnia, mert a következő lépésben ehhez az értékhez hozzá fogjuk adni a k. helyen álló x-nek a d-ed részét, és a feltétel szerint a hozzáadás után ott x-nek kell szerepelnie. A többi elemnél x - (2/d) x, x - (3/d) 
          x, ... áll, mivel azon elemeket úgy kapjuk meg, hogy k-ról k+1-re, onnan k+2-re, k+3-ra, stb. lépünk és ezalatt a j=k+i. elemhez i-szer adunk (1/d) x-et, és a feltétel szerint mire k eléri j-t, akkorra a j. elem is x lesz. A listában a k. lépésnél d db nem nulla elem van, de az átláthatóság kedvéért vegyük bele a következő elemet is, ez úgyis 0 lesz. Ezek összege 1 lesz, mivel a lépések során mindig megmaradt a listának azon tulajdonsága, hogy a listában szereplő elemek összege 1.

Solve[(∑_(t = 0)^d)(x - (t/d) x) == 1, 
      x]

Így látható, hogy x csak  (2/(1 + d)) = 1/(((1 + d)/2)) lehet, ami esetünkben pontosan megegyezik \(TraditionalForm\`1\/\(Várható\ érték\)\)-kel.

Határérték hamis kockára: Érdekesebb a lehetséges határérték meghatározása, ha nem szabályos a kocka. Meg kell említeni, hogy nem biztos, hogy a sorozat konvergens, így a határértékről sem lehet mindig beszélni. Jelöljük (Subscript[p, k])-val annak az esélyét, hogy a hamis d oldalú kockával k-t dobunk. Ekkor tudjuk, hogy ezek összege 1-et ad, továbbá a fent részletezett elgondolás alapján:
	x + (x - (Subscript[p, 1]) x) + (x - (Subscript[p, 1]) x - 
                  (Subscript[p, 2]) x) + (x - (Subscript[p, 1]) x - (Subscript[p, 2]) x - 
                  (Subscript[p, 3]) x) +  ...   + (x - (Subscript[p, 1]) 
                    x -  ...  - (Subscript[p, d - 1]) x - (Subscript[p, d]) x) = 1
	Mivel a j=k+i. elemhez hozzáadjuk (Subscript[p, i]) x-et az első lépésben, majd (Subscript[p, i - 1]) x-et, (Subscript[p, i - 2]) x-et, ... (Subscript[p, 1]) x-et. (Az összeadandóknál az utolsó elem 0 lesz, ám ezt hozzávehetjük, nem változtat semmit az eredményen). Továbbá igaz, hogy a listában szereplő elemek összege mindig 1-et ad.

(∑_(i = 0)^d)(x - (∑_(t = 1)^i) (Subscript[p, t]) 
                  x) == 1;

Számoljuk meg az egyes tagokat más sorrendben. x-ből van d db, (Subscript[p, 1]) x-ből d-1 db, (Subscript[p, 2]) x-ből d-2 db, stb., így:

(∑_(i = 0)^d)(x - (∑_(t = 1)^i) (Subscript[p, t]) 
                  x) == 
        x (d - (∑_(t = 1)^d)(d - t) (Subscript[p, t])) == 
        1;

Solve[{x (d - (∑_(t = 1)^d)(d - t) (Subscript[p, t])) == 1}, 
      x]

Szedjük szét a szummát:

(1/(d - (∑_(t = 1)^d)(d - t) (Subscript[p, t]))) == 
        (1/(d - d (∑_(t = 1)^d) (Subscript[p, t]) + (∑_(t = 1)^d) t (Subscript[p, t]))) == (1/((∑_(t = 1)^d) t (Subscript[p, t]))) == 
        (1/(Várható érték));

Mivel a (Subscript[p, t])-k összege 1, a t (Subscript[p, t])-k összege a várható érték.

2. Gráfok véletlenszerű bejárása

2.1. Bevezetés

Válasszunk ki egy pontot egy irányított gráfban. A következő lépésben a pontból kifutó élek közül azonos valószínűséggel válasszuk ki az egyiket és menjünk át az él által mutatott pontba. Ha egy pontból nem fut ki él (nyelő), akkor maradjunk ott. Felmerülhet a kérdés, hogy hol milyen valószínűséggel leszünk
	- k lépés múlva
	- k ->  ∞ esetén

2.2. Algoritmus elkészítése, számolás konkrét gráfra

Számozzuk meg a gráf pontjait, és tároljuk el egy oszlopvektorban, hogy egy adott lépésben milyen valószínűséggel leszünk egy adott pontban. Hozzunk létre egy mátrixot úgy, hogy az i. sor j. eleme azt határozza meg, hogy j-ből mekkora valószínűséggel lépünk i-be. A következő állapot eléréséhez nem kell mást tennünk, mint megszorozzuk a mátrixot balról az oszlopvektorral. Ha több lépést szeretnénk egyszerre kiszámolni, akkor használjuk a Mathematica beépített MatrixPower eljárását, ugyanis az sajátértékekkel és vektorok segítségével lényegesen gyorsan számolja ki egy négyzetes mátrix adott hatványát. A szemléltetéshez használhatjuk a Mathematica beépített algoritmusait a gráfok kezelésére.

Az egyszerűség kedvérért az algoritmusban azon pontokhoz, amelyek kifoka 0, adjunk egy hurokélet. Így a gráf a feladat szemszögéből ugyanolyan tulajdonságokkal bír, de könnyebb vele számolni.

<< DiscreteMath`Combinatorica`

GraphKStepLater[G_, start_, k_] := 
      MatrixPower[
Transpose[
            ToAdjacencyMatrix[
                Fold[AddEdge[#1, {#2, #2}] &, G, 
                  Position[Degrees[G], 0] // Flatten]]/(Degrees[
                    G] /. {0 -> 1})], k] . 
        Array[KroneckerDelta[start, #] &, Length[Vertices[G]]]

Nézzünk példát egy olyan gráfra, amelyben nincs nyelő, és úgy vannak benne a körök, hogy még szemléletesen is látszódjon, hogy előbb-utóbb azonos lesz annak a valószínűsége, hogy valamelyik ponton leszünk.

L = {{0, 1, 0, 1}, {1, 0, 0, 1}, {1, 1, 0, 0}, {0, 0, 1, 
            0}};

\(ShowGraph[
      G = MakeGraph[
          Range[Length[
              L]], \((L[[#1, #2]] == 1)\) &], VertexNumber -> True, VertexNumberColor -> Red, 
      TextStyle -> {FontFamily -> "Times", 
          FontSize -> 18}, PlotRange -> All]\)

Legyen a kezőpont az első pont.

<< Graphics`Graphics`

Az alábbiakban kirajzoltatom, hogy 0, 1, 2, 3, ... 15 lépés múlva mekkora lesz a valószínűsége, hogy az egyes pontokon leszünk.

Table[
      DisplayTogetherArray[
        Table[BarChart[GraphKStepLater[G, 1, k], 
            PlotStyle -> PointSize[0.02]], {k, 4 l, 4 l + 3, 1}], 
        ImageSize -> 530], {l, 0, 3}]

GraphKStepLater[G, 1, k] // Simplify

Limit[GraphKStepLater[G, 1, k], k -> ∞]

A fenti két sor magyarázatra szorul. Miért tehettük meg, hogy a k. lépést általánosan írhattuk fel? A válasz a PowerMatrix működésében keresendő.
	A PowerMatrix képes egy szimbólum értékére felemelni a mátrixot. Az eljárás pontos működését nem tudom, így lehet, hogy az általam itt leírt mátrixhatványozásnak egy gyorsabb módszerét alkalmazza.
	Mit tudunk a már felhatványozott mátrix sajátértékeiről és sajátvekoráiról? Ha az eredeti A mátrixot ha megszorozzuk jobbról egy saját vektorával, akkor annak az iránya megmarad (definíció szerint A . v == λv). Ha az (A.A.A. ... A).v kifejezésben v sajátvektora A-nak, úgy átzárójelezéssel kijön, hogy sajátvektora lesz a hatványozott mátrixnak is. A sajátértékek a hatványozás során külön-külön hatványozódnak. Ismerve a keresendő mátrix sajátértékeit és sajátvektorait, azt elő tudjuk állítani.
	Az eredeit mátrix:

(A = 
          Transpose[
            ToAdjacencyMatrix[
                Fold[AddEdge[#1, {#2, #2}] &, G, 
                  Position[Degrees[G], 0] // Flatten]]/(Degrees[
                    G] /. {0 -> 1})]) // MatrixForm

Sajátértékei és sajátvektorai:

values = Eigenvalues[A]

vectors = Eigenvectors[A] // Simplify

U = Transpose[vectors];

Emeljük fel például a 10. hatványára az A mátrixot.

U . DiagonalMatrix[(values^10)] . Inverse[U] // MatrixForm // 
      Simplify

És ez tényleg megegyezik a numerikusan számolttal:

% == Nest[# . A &, IdentityMatrix[Length[A]], 10]

Vegyük észre, hogy a fenti példában mindegy, hogy melyik volt a kezdőpont, ugyanaz lesz az eredmény.

Table[
      Limit[GraphKStepLater[G, t, k], k -> ∞], {t, 
        Length[Vertices[G]]}]

Ha az összes pontból indulva ugyanaz lesz az eredmény, úgy bármilyen eloszlás szerint is tennénk le kezdetben a pontokat, mindig a közös határértékhez fog tartani az eloszlás.

2.3 Néhány érdekes példa

1. példa

Legyen a gráf egy (Subscript[K, 4])gráf és egy pont uniója, ahol a teljes négyesből egy él mutasson a pontba.

G1 = 
        AddVertices[CompleteGraph[4] // MakeDirected, 
          1];
G1 = AddEdges[G1, {4, 5}];

ShowGraph[G1, VertexNumber -> True, VertexNumberColor -> Red, 
      TextStyle -> {FontFamily -> "Times", 
          FontSize -> 18}, PlotRange -> All]

Table[
      DisplayTogetherArray[
        Table[BarChart[GraphKStepLater[G1, 1, k], 
            PlotStyle -> PointSize[0.02]], {k, 4 l, 4 l + 3, 1}], 
        ImageSize -> 530], {l, 0, 3}]

Bármelyik pontból is indítjuk a szimulációt, az eredmény ugyanaz lesz: előbb-utóbb az 5-ös pontra lépünk. Bármely kezdőponttal a határérték ugyanaz:

Table[
      Limit[GraphKStepLater[G1, t, k], k -> ∞], {t, 
        Length[Vertices[G1]]}]

2. példa

Egy példa olyan gráfra, amelynél a valószínűségek sorozata nem konvergens bizonyos pontokból indítva, de konvergens egy adott pontból indítva.

L2 = {{0, 1, 1, 1}, {0, 0, 1, 0}, {0, 0, 0, 1}, {0, 1, 0, 
            0}};

\(ShowGraph[
      G2 = MakeGraph[
          Range[Length[
              L2]], \((L2[[#1, #2]] == 1)\) &], VertexNumber -> True, VertexNumberColor -> Red, 
      TextStyle -> {FontFamily -> "Times", 
          FontSize -> 18}, PlotRange -> All]\)

Egy (Subscript[K, 3])-hoz hozzáveszünk egy pontot, amelyből mindegyik másik pontba vezet él. Ekkor ha a hozzávett pontból indítjuk a szimulációt, úgy konvergens lesz, de ha bármelyik másik pontból indítjuk, akkor divergens. Például a 2. pontból indítva:

DisplayTogetherArray[
      Table[BarChart[GraphKStepLater[G2, 2, k], 
          PlotStyle -> PointSize[0.02]], {k, 0, 6, 1}], 
      ImageSize -> 700]

Limit[GraphKStepLater[G2, 1, k], k -> ∞]

Könnyen belátható, hogy ebben a példában pontosan akkor lesz egyenletes az eloszlás, ha a 2., 3., 4. pontokból azonos valószínűséggel indulunk.

3. példa

Egy másik érdekes példa, amikor a határérték olyan, hogy mindegyik pontban nem nulla valószínűséggel vagyunk, mégsem egyenletes az eloszlás. Például:

L3 = {{0, 1, 0}, {1, 0, 1}, {1, 0, 0}};

\(ShowGraph[
      G3 = MakeGraph[
          Range[Length[
              L3]], \((L3[[#1, #2]] == 1)\) &], VertexNumber -> True, VertexNumberColor -> Red, 
      TextStyle -> {FontFamily -> "Times", 
          FontSize -> 18}, PlotRange -> All]\)

Bármelyik pontból indítva a határéték ugyanaz.

Table[
      Limit[GraphKStepLater[G3, t, k], k -> ∞], {t, 
        Length[Vertices[G3]]}]

2.4. A dobókockás probléma visszavezetése gráf véletlenszerű bejárására

A fenti algoritmus segítségével keressünk képletet az első feladatra. A gráf legyen olyan, hogy mindegyik pontból pontosan a következő 6 pontba fusson él. Számoljuk ki, hogy mekkora eséllyel dobhatjuk ki a 20-at dobások összegeként. Mivel az első pontról indulunk, ezért indexeltolást kell alkalmaznunk. 27 elemű listát kell létrehoznunk, hiszen adnunk kell lehetőséget a "túldobásra". Az eredmény a lista 21. eleménél lesz.

L4 = 
      Table[If[1 ≤ j - i ≤ 6 && i < 21, 1, 0], {i, 
          27}, {j, 27}]

G4 = 
        MakeGraph[
          Range[Length[
              L4]], (L4[[#1, #2]] == 1) &];

GraphKStepLater[G4, 1, 
        20][[21]]

Ellenőrzésképpen:

ReachWithSum[20, 6]

3. Összegzés

A fent leírt módszerek segítségével gyorsan és pontosan kiszámolható mekkora a valószínűsége, hogy egy adott értéket egy tetszőleges oldalszámú szabályos kockával dobások összegekén elérjünk. A fentebb ismertetett 3 eljárás bármelyikét könnyedén át lehet írni súlyozott kockára. Ezt nem találtam elég érdekesnek, úgy gondolom, aki részletesen átolvasta a fentieket, az maga is könnyedén meg tudná ezt írni.
	A 2. részben adtam egy függvényt, amivel elég sok esetben meg lehet vizsgálni gráfok véletlenszerű bejárásának az eloszlásának a határértékét. Ezt tovább lehetne finomítani, hogy tetszőleges eloszlás esetén megállapítsa a határétéket. Ha minden pontból indulva ugyanaz a határérték, akkor bármilyen eloszlás esetén ezt a határétéket fogjuk megkapni. Lehetne vizsgálni, hogy mely gráfok rendelkeznek ezzel a tulajdonsággal, azaz bármilyen pontból is indulunk létezik határérték, és azok megegyeznek. A probléma szerintem érdekes mind irányított, mind irányítatlan gráfokra.

Móra Péter