Programozási feladat3
Nagy László
BFX9KU

1 Dim bolyongások.

1 bolyongó esetén

Szimmetrikus p=q esete.

Bolyong[n_]:=First[Position[Accumulate[RandomChoice[ {0.5,0.5}->{-1,1} ,n]],0]]

Bolyong[100]

ABolyong[n_]:=ListLinePlot[Accumulate[RandomReal[{-1,1},n]],Filling->Axis]

ABolyong[100]

Tetszőleges p,q esete.

BolyongP[n_,p_,q_]:=First[Position[Accumulate[RandomChoice[ {p,q}->{-1,1} ,n]],0]]

BolyongP[100,0.1,0.9]

ABolyongP[n_,p_,q_]:=ListLinePlot[Accumulate[RandomChoice[ {p,q}->{-1,1} ,n]],Filling ->Axis ]

ABolyongP[100,0.1,0.9]

Véletlen lépéshossz (0,1 közötti valás) , p=q  esete.

Bolyongvh[n_]:=
First[Position[Accumulate[RandomReal[1,n]*RandomChoice[{-1,1},n]],0]]

Bolyongvh[100]

ABolyongvh[n_]:=ListLinePlot[Accumulate[RandomReal[1,n]*RandomChoice[{-1,1},n]],Filling -> Axis]

ABolyongvh[100]

Véletlen lépshossz (0,1 közötti valós), tetszőleges (p,q) esete.

BolyongPvh[n_,p_,q_]:=
First[Position[Accumulate[RandomChoice[{p,q}->{-1,1},n]*RandomReal[1,n]],0]]

BolyongPvh[100,0.1,0.9]

ABolyongPvh[n_,p_,q_]:=
ListLinePlot[Accumulate[RandomChoice[{p,q}->{-1,1},n]*RandomReal[1,n]],Filling -> Axis]

ABolyongPvh[100,0.1,0.9]

Véletlen lépéshossz (legalább k, legfeljebb l),  tetszőleges p,q esete.

BolyongPvhT[n_,p_,q_,k_,l_]:=First[Position[Accumulate[RandomChoice[{p,q}->{k,l},n]*RandomReal[1,n]],0]]

BolyongPvhT[100,0.1,0.9,2,5]

ABolyongPvhT[n_,p_,q_,k_,l_]:=
ListLinePlot[Accumulate[RandomChoice[{p,q}->{k,l},n]*RandomReal[1,n]],Filling -> Axis]

ABolyongPvhT[100,0.1,0.9,2,5]

Több bolyongó esetén

K bolyongó, szimmetrikus p=q esete.

KBolyong[n_,k_]:= Table[First[Position[Accumulate[RandomChoice[{-1,1},n]],0]],{k}]

KBolyong[100,2]

AKBolyong[n_,k_]:= ListLinePlot[Table[Accumulate[RandomReal[{-1,1},n]],{k}],Filling->Axis]

AKBolyong[100,2]

K bolyongó, tetszőleges p,q esete.

KBolyongP[n_,p_,q_,k_]:=Table[First[Position[Accumulate[RandomChoice[ {p,q}->{-1,1} ,n]],0]],{k}]

KBolyongP[100,0.1,0.9,2]

AKBolyongP[n_,p_,q_,k_]:=ListLinePlot[Table[Accumulate[RandomChoice[ {p,q}->{-1,1} ,n]],{k}],Filling -> Axis]

AKBolyongP[100,0.1,0.9,2]

K bolyongó, véletlen lépéshossz (0,1 közötti valás) , p=q  esete.

KBolyongvh[n_,k_]:=
Table[First[Position[Accumulate[RandomReal[1,n]*RandomChoice[{-1,1},n]],0]],{k}]

KBolyongvh[100,2]

AKBolyongvh[n_,k_]:=
ListLinePlot[Table[Accumulate[RandomReal[1,n]*RandomChoice[{-1,1},n]],{k}],Filling -> Axis]

AKBolyongvh[100,2]

K bolyongó, véletlen lépshossz (0,1 közötti valós), tetszőleges (p,q) esete.

KBolyongPvh[n_,p_,q_,k_]:=
Table[First[Position[Accumulate[RandomChoice[{p,q}->{-1,1},n]*RandomReal[1,n]],0]],{k}]

KBolyongPvh[100,0.1,0.9,2]

AKBolyongPvh[n_,p_,q_,k_]:=
ListLinePlot[Table[Accumulate[RandomChoice[{p,q}->{-1,1},n]*RandomReal[1,n]],{k}],Filling ->Axis]

AKBolyongPvh[100,0.1,0.9,2]

K bolyongó, véletlen lépéshossz (legalább a, legfeljebb b), szimmetrikus (p=q) esete.

KBolyongPvhT[n_,p_,q_,a_,b_,k_]:=Table[First[Position[Accumulate[RandomChoice[{p,q}->{a,b},n]*RandomReal[1,n]],0]],{k}]

KBolyongPvhT[100,0.1,0.9,2,5,2]

AKBolyongPvhT[n_,p_,q_,a_,b_,k_]:=ListLinePlot[Table[Accumulate[RandomChoice[{p,q}->{a,b},n]*RandomReal[1,n]],{k}],Filling -> Axis]

AKBolyongPvhT[100,0.1,0.9,2,5,2]

2 Dim bolyongások.

1 bolyongó esetén

Rögzített (fix) vektorok ( (0,1),(1,0),(-1,0),(0,-1) ) esetén.

Szimmetrikus bolyongás p=q=P=Q , (0,1),(1,0),(0,-1),(-1,0) vektorokkal.

BolyongF[n_]:=First[Position[Accumulate[RandomChoice[{{1,0},{-1,0},{0,1},{0,-1}},n]],{0,0}]]

BolyongF[100]

ABolyongF[n_]:=ListLinePlot[Accumulate[RandomChoice[{{1,0},{-1,0},{0,1},{0,-1}},n]]]

ABolyongF[100]

Tetszőleges p,q,P,Q  a (0,1),(1,0),(-1,0),(0,-1) vektorokkal.

BolyongFP[n_,p_,q_,P_,Q_]:=First[Position[Accumulate[RandomChoice[{p,q,P,Q}->{{1,0},{-1,0},{0,1},{0,-1}},n]],{0,0}]]

BolyongFP[100,0.1,0.4,0.2,0.3]

ABolyongFP[n_,p_,q_,P_,Q_]:=ListLinePlot[Accumulate[RandomChoice[{p,q,P,Q}->{{1,0},{-1,0},{0,1},{0,-1}},n]]]

ABolyongFP[100,0.1,0.4,0.2,0.3]

Véletlen lépéshossz ( 0,1 közötti valós számmal szorozva a lépés irányát, és nagyságát megadó vektor) p=q=P=Q esete.

BolyongFvh[n_]:=
First[Position[Accumulate[RandomReal[1]*RandomChoice[{{1,0},{-1,0},{0,1},{0,-1}},n]],{0,0}]]

BolyongFvh[100]

ABolyongFvh[n_]:=
ListLinePlot[Accumulate[RandomReal[1]*RandomChoice[{{1,0},{-1,0},{0,1},{0,-1}},n]]]

ABolyongFvh[100]

Véletlen lépéshossz ( 0,1 között valós számmal szorozva a lépés irányát, és nagyságát megadó vektort), tetszőleges p,q,P,Q esete.

BolyongFPvh[n_,p_,q_,P_,Q_]:=First[Position[Accumulate[RandomReal[1]*RandomChoice[{p,q,P,Q}->{{1,0},{-1,0},{0,1},{0,-1}},n]],{0,0}]]

BolyongFPvh[100,0.1,0.4,0.2,0.3]

ABolyongFPvh[n_,p_,q_,P_,Q_]:=ListLinePlot[Accumulate[RandomReal[1]*RandomChoice[{p,q,P,Q}->{{1,0},{-1,0},{0,1},{0,-1}},n]]]

ABolyongFPvh[100,0.1,0.4,0.2,0.3]

Véletlen lépéshossz (legalább k-val, legfeljebb l-lel szorozzuk a vektort), tetszőleges p,q,P,Q esete.

BolyongFPvhT[n_,p_,q_,P_,Q_,k_,l_]:=First[Position[Accumulate[RandomReal[{k,l}]*RandomChoice[{p,q,P,Q}->{{1,0},{-1,0},{0,1},{0,-1}},n]],{0,0}]]

BolyongFPvhT[100,0.1,0.4,0.2,0.3,2,5]

ABolyongFPvhT[n_,p_,q_,P_,Q_,k_,l_]:=ListLinePlot[Accumulate[RandomReal[{k,l}]*RandomChoice[{p,q,P,Q}->{{1,0},{-1,0},{0,1},{0,-1}},n]]]

ABolyongFPvhT[100,0.1,0.4,0.2,0.3,2,5]

Tetszőleges vektorok esetén.

Tetszőleges vektor ( 1.-2. koordinátája legalább a, de legfeljebb b).

Kezdőpontba (0,0) pontba való visszatérés.

TBolyong[n_,a_,b_]:=First[Position[Accumulate[RandomReal[{a,b},{n,2}]],{0,0}]]

TBolyong[100,2,4]

X tengelyen lévő pontok

TBolyongX[n_,a_,b_]:=Position[First /@ Accumulate[RandomReal[{a,b},{n,2}]],0]

TBolyongX[100,2,6]

Y tengelyen lévő pontok.

TBolyongY[n_,a_,b_]:= Position[Table[Accumulate[RandomReal[{a,b},{n,2}]][[i,2]],{i,n}],0]

TBolyongY[100,1,4]

ATBolyong[n_,a_,b_]:=ListLinePlot[Accumulate[RandomReal[{a,b},{n,2}]],ColorFunction-> "BlueGreenYellow"]

ATBolyong[100,2,3]

K bolyongó esetén

Adott  ((1,0),(-1,0),(0,1),(0,-1) ) vektorok esetén.

Szimmetrikus bolyongás p=q=P=Q , (0,1),(1,0),(0,-1),(-1,0) vektorokkal.

TKBolyong[n_,k_]:=First[Table[Position[Accumulate[RandomChoice[{{1,0},{-1,0},{0,1},{0,-1}},n]],{0,0}],{k}]]

TKBolyong[100,2]

ATKBolyong[n_,k_]:=ListLinePlot[Table[Accumulate[RandomChoice[{{1,0},{-1,0},{0,1},{0,-1}},n]],{k}],Filling -> Axis]

ATKBolyong[100,2]

Tetszőleges p,q,P,Q  a (0,1),(1,0),(-1,0),(0,-1) vektorokkal.

TKBolyongFP[n_,k_,p_,q_,P_,Q_]:=First[Table[Position[Accumulate[RandomChoice[{p,q,P,Q}->{{1,0},{-1,0},{0,1},{0,-1}},n]],{0,0}],{k}]]

TKBolyongFP[100,2,0.1,0.4,0.2,0.3]

ATKBolyongFP[n_,k_,p_,q_,P_,Q_]:=ListLinePlot[Table[Accumulate[RandomChoice[{p,q,P,Q}->{{1,0},{-1,0},{0,1},{0,-1}},n]],{k}],Filling -> Axis]

ATKBolyongFP[100,2,0.1,0.4,0.2,0.3]

Véletlen lépéshossz ( 0,1 közötti valós számmal szorozva a lépés irányát, és nagyságát megadó vektor) p=q=P=Q esete.

TKBolyongFvh[n_,k_]:=First[Table[Position[Accumulate[RandomReal[1]*RandomChoice[{{1,0},{-1,0},{0,1},{0,-1}},n]],{0,0}],{k}]]

TKBolyongFvh[100,2]

ATKBolyongFvh[n_,k_]:=
ListLinePlot[Table[Accumulate[RandomReal[1]*RandomChoice[{{1,0},{-1,0},{0,1},{0,-1}},n]],{k}],Filling -> Axis]

ATKBolyongFvh[100,2]

Véletlen lépéshossz ( 0,1 között valós számmal szorozva a lépés irányát, és nagyságát megadó vektort), tetszőleges p,q,P,Q esete.

TKBolyongFPvh[n_,k_,p_,q_,P_,Q_]:=First[Table[Position[Accumulate[RandomReal[1]*RandomChoice[{p,q,P,Q}->{{1,0},{-1,0},{0,1},{0,-1}},n]],{0,0}],{k}]]

TKBolyongFPvh[100,2,0.1,0.4,0.2,0.3]

ATKBolyongFPvh[n_,k_,p_,q_,P_,Q_]:=ListLinePlot[Table[Accumulate[RandomReal[1]*RandomChoice[{p,q,P,Q}->{{1,0},{-1,0},{0,1},{0,-1}},n]],{k}],Filling -> Axis]

ATKBolyongFPvh[100,2,0.1,0.4,0.2,0.3]

Véletlen lépéshossz (legalább a-val, legfeljebb b-lel szorozzuk a vektort), tetszőleges p,q,P,Q esete.

TKBolyongFPvhT[n_,k_,p_,q_,P_,Q_,a_,b_]:=First[Table[Position[Accumulate[RandomReal[{a,b}]*RandomChoice[{p,q,P,Q}->{{1,0},{-1,0},{0,1},{0,-1}},n]],{0,0}],{k}]]

TKBolyongFPvhT[100,2,0.1,0.4,0.2,0.3,2,5]

ATKBolyongFPvhT[n_,k_,p_,q_,P_,Q_,a_,b_]:=ListLinePlot[Table[Accumulate[RandomReal[{a,b}]*RandomChoice[{p,q,P,Q}->{{1,0},{-1,0},{0,1},{0,-1}},n]],{k}],Filling -> Axis]

ATKBolyongFPvhT[100,2,0.1,0.4,0.2,0.3,2,5]

Tetszőleges vektorok esetén.

Tetszőleges vektor ( 1.-2. koordinátája legalább a, de legfeljebb b).

A kezdőpontba (0,0) pontba való visszatérés.

TKBolyong1[n_,a_,b_,k_]:=First[Table[Position[Accumulate[RandomReal[{a,b},{n,2}]],{0,0}],{k}]]

TKBolyong1[100,2,5,2]

X tengelyen lévő pontok.

TKBolyong2[n_,a_,b_,k_]:=First[Table[Position[Accumulate[RandomReal[{a,b},{n,2}]],{0,0}],{k}]]

TKBolyong2[100,2,5,2]

Y tengelyen lévő pontok.

TKBolyongY[n_,a_,b_,k_]:= Position[Table[Table[Accumulate[RandomReal[{a,b},{n,2}]][[i,2]],{i,n}],{k}],0]

TKBolyongY[100,2,5,2]

ATKBolyong[n_,a_,b_,k_]:=ListLinePlot[Table[Accumulate[RandomReal[{a,b},{n,2}]],{k}]]

ATKBolyong[100,2,5,2]

Az output frissítése:

A fentiekben definiált, tetszőleg bolyongás outputjának frissítése az alábbi módon hívható meg:

Dynamic["A kívánt bolyongás, megfelelő paraméterekkel"*x/x]
Do[FinishDynamic[];x=n,{n,"frissítések száma"}]

Egy példa, ennek megvalósítására:

AKBolyong[n_,k_]:= ListLinePlot[Table[Accumulate[RandomReal[{-1,1},n]],{k}],Filling->Axis]

Dynamic[AKBolyong[100,3]*x/x]
Do[FinishDynamic[];x=n,{n,10}]

Symmetric Random Walk

Gráf megadása

Adjacence Mátrix segítségvel megadatt gráf esete.

<<Combinatorica`

Először a szomszédossági mátrixot kell megadni, erre több lehetőségünk adódik, ezek közül három:

Manuálisan beírom a mátrixot:

K1={{0,1,1},{1,0,1},{0,1,1}}

Függvény segítségével:

Megad1[k_]:=
K2=Table[f[i]+g[j],{i,k},{j,k}]

Megad1pl[k_]:=K2=Table[i^3+j,{i,k},{j,k}]

Megad1pl[3]

Random szám generálásával :

Megad2[k_,a_,b_]:=
K3=RandomInteger[{a,b},{k,k}]

Megad2[3,1,11]

Miután megadtuk a mátrixot, létrehozzuk a gráfot:

Graf=FromAdjacencyMatrix[K1]
Elek=Edges[Graf]
Elso=Last[First[Elek]]

Majd elindítjuk a bolyongást:

Egyik=Cases[Elek,{a_,Elso}->a]
Masik=Cases[Elek,{Elso,b_}->b]
Ide=Join[Egyik,Masik]
Idelep=RandomChoice[Ide]
idelep={Idelep}
ShowGraph[SetGraphOptions[Graf,{{Idelep,VertexColor->Green,VertexStyle->Disk[Large]}},EdgeColor->Blue]]
Elso=idelep
Elso=First[Elso]

Graf=FromAdjacencyMatrix[K2]
Elek=Edges[Graf]
Elso=Last[First[Elek]]

Egyik=Cases[Elek,{a_,Elso}->a]
Masik=Cases[Elek,{Elso,b_}->b]
Ide=Join[Egyik,Masik]
Idelep=RandomChoice[Ide]
idelep={Idelep}
ShowGraph[SetGraphOptions[Graf,{{Idelep,VertexColor->Green,VertexStyle->Disk[Large]}},EdgeColor->Blue]]
Elso=idelep
Elso=First[Elso]

Graf=FromAdjacencyMatrix[K3]
Elek=Edges[Graf]
Elso=Last[First[Elek]]

Egyik=Cases[Elek,{a_,Elso}->a]
Masik=Cases[Elek,{Elso,b_}->b]
Ide=Join[Egyik,Masik]
Idelep=RandomChoice[Ide]
idelep={Idelep}
ShowGraph[SetGraphOptions[Graf,{{Idelep,VertexColor->Green,VertexStyle->Disk[Large]}},EdgeColor->Blue]]
Elso=idelep
Elso=First[Elso]

Random fa generálása

<<Combinatorica`
Fa=RandomTree[10];
Elek=Edges[Fa]
Elso=Last[First[Elek]]

Egyik=Cases[Elek,{a_,Elso}->a]
Masik=Cases[Elek,{Elso,b_}->b]
Ide=Join[Egyik,Masik]
Idelep=RandomChoice[Ide]
idelep={Idelep}
ShowGraph[SetGraphOptions[Fa,{{Idelep,VertexColor->Green,VertexStyle->Disk[Large]}},EdgeColor->Blue]]
Elso=idelep
Elso=First[Elso]

Gyökeres fa esete

<<Combinatorica`
Fa=RootedEmbedding[RandomTree[20],2]
Elek=Edges[Fa]
Elso=Last[First[Elek]]

Egyik=Cases[Elek,{a_,Elso}->a]
Masik=Cases[Elek,{Elso,b_}->b]
Ide=Join[Egyik,Masik]
Idelep=RandomChoice[Ide]
idelep={Idelep}
ShowGraph[SetGraphOptions[Fa,{{Idelep,VertexColor->Green,VertexStyle->Disk[Large]}},EdgeColor->Blue]]
Elso=idelep
Elso=First[Elso]

Ragadozó, növényevő

A már tárgyalt lista megadások közül tekintsük egy lehetséges esetet.
A 2-3Dim esettel foglalkozunk.

Pontok2[a_,b_,pontsz_]:=
Graphics[{ 
	{PointSize[0.025], Green,Point[{K2=RandomReal[{a,b},{pontsz,2}]}]}
,
	{PointSize[0.05],Red,Point[{0,0}]}
}]

Pontok2[-1,1,10]

Pontok3[a_,b_,pontsz_]:=
Graphics3D[ {
 {PointSize[0.025], Green,Point[{K3=RandomReal[{a,b},{pontsz,3}]}]}
,
{PointSize[0.05],Red,Point[{0,0,0}]}
}]

Pontok3[-1,1,10]

Kioltás 2Dim esetben. Tekintsünk egy kitüntetett pontot (ragadozó) kiolt egy másik pontot, ha középpontjaik (euklideszi) távolsága maximum 0.075 . 
A ragadozó a (0.5,0.5)pontból indul, a többi pont helyét a fentiekben meghatároztuk. Egy lépés nem más, mint a kiindulási pontból egy ugyanazon középpontú 2 sugarú zárt körlap egy véletlen pontjába történő átlépés.

Dist=EuclideanDistance[#,{0.5,0.5}]&/@ K2;
Kisebb=Select[Dist ,#<0.075 &];
Megeszi=Position[Dist,#] & /@ Kisebb;
Megeszi=Flatten[Megeszi];
Megeszi=Tuples[Megeszi,1];
K2=Delete[K2,Megeszi];

a=RandomReal[{1,2}]
K2=K2*a;

Graphics[{
{PointSize[0.025],Green,Point[#] & /@ K2}
,
{PointSize[0.05],Red,Point[{0.5,0.5}*a]}
}]