3. házi feladat

1. feladat

Írjunk programot véletlen számok generálására Neumann János módszere alapján.

Neumann J. ötlete

Graphics[
{
Flatten[Table[{RGBColor[.7,.5,i/4],Rectangle[{i,0}]},{i,0,3}]],
Black,Inset[Style["seed",18],{-1,.5}],
Gray,Arrowheads->.05,Arrow[{{2,0},{2,-2}}],
Flatten[
Table[{RGBColor[.2,i/8,.4-i/8],Rectangle[{i,-3}]},{i,-2,5}]
],
Black,Inset[Style["(seed^2)",18],{-3,-2.5}],
Gray,Arrowheads->.05,Arrow[{{2,-3},{2,-5}}],
Black,Inset[Style["middle 4 digits",14,Bold],{2,-4}],
Flatten[
Table[{RGBColor[.2,i/8,.4-i/8],Rectangle[{i,-6}]},{i,0,3}]
],
Black,Inset[Style["output",18],{-1,-5.5}],
Gray,Arrowheads->.05,Arrow[{{4,-5.5},{7,-5.5},{7,.5},{4,.5}}],
Black,Inset[Style["output becomes next seed",14,Bold],{7.5,-2.5},Automatic,Automatic,{{0,-1},{1,0}}]
}
]

neumann[n_,k_]:=NestList[FromDigits[Take[Join[ConstantArray[0,8-Length[#]],#],{-6,-3}]]&[IntegerDigits[((#)^2)]]&,n,k]

PaddedForm[#,3,NumberPadding->"0"]&[24]

Join[ConstantArray[0,8-Length[#]],#]&[{5,7,6,0,0}]

Take[Join[ConstantArray[0,8-Length[#]],#],{-6,-3}]&[{5,7,6,0,0}]

FromDigits[Take[Join[ConstantArray[0,8-Length[#]],#],{-6,-3}]]&[IntegerDigits[#]]&[(240^2)]

FromDigits[Take[Join[ConstantArray[0,8-Length[#]],#],{-6,-3}]]&[IntegerDigits[((#)^2)]]&[240]

neumann2[n_,k_]:=NestList[FromDigits[Take[Join[ConstantArray[0,8-Length[#]],#],{-6,-3}]]&[IntegerDigits[((#)^2)]]&,n,k]

TableForm[Transpose[{neumann2[240,13],((neumann2[240,13])^2)}]]

TableForm[Transpose[{neumann2[2400,13],((neumann2[2400,13])^2)}]]

Union[neumann2[7600,12]]

Bartha Zsolt

Az f függvény megadja a szám négyzete jegyeinek listáját 2-es számrendszerben, a g függvény kiválasztja a lista középső 8 számjegyét, a h függvény pedig megadja a 2-es számrendszerben ezekből a jegyekből álló számot.

ClearAll[f,g,h,ff];
f[x_]:=IntegerDigits[(x^2),2];
g[l_]:=Table[l[[Floor[Length[l]/2]+i]],{i,-3,4}];
h[l_]:=Sum[l[[i]] (2^(8-i)),{i,1,8}];
ff[x_]:=h[g[f[x]]];

Például :

NestList[ff,2^^11010010,5]

NestList[ff,2^^11010010,15]

Forberger Klaudia

Az egyik első képzési módot Neumann János adta meg: legyen pl. a mag  (Subscript[x, 1]) = 10101001 , képezzük ennek a négyzetét, és vegyük ki a középső 8 számjegyet, ez lesz  (Subscript[x, 2])  , majd hasonlóan folytassuk az eljárást  (Subscript[x, 2]) -vel és így tovább.

x1= 10101001
l=IntegerDigits[x1^2]
k=Floor[Length[l]/2.0]
t=Take[l,{k-3,k+4}]

x2=FromDigits[{0,3,0,2,2,1,2,0}]

IntegerDigits[x2^2]
Floor[Length[IntegerDigits[x2^2]]/2.0]
Take[IntegerDigits[x2^2],{Floor[Length[IntegerDigits[x2^2]]/2.0]-3,Floor[Length[IntegerDigits[x2^2]]/2.0]+4}]
FromDigits[Take[IntegerDigits[x2^2],{Floor[Length[IntegerDigits[x2^2]]/2.0]-3,Floor[Length[IntegerDigits[x2^2]]/2.0]+4}]]

k tetszőleges pozitív egész szám

k=59
For[i=1;t=101010001,i<k,i++,t=FromDigits[Take[IntegerDigits[t^2],{Floor[Length[IntegerDigits[t^2]]/2.0]-3,Floor[Length[IntegerDigits[t^2]]/2.0]+4}]]]
Print[t]

Geszler Döme

a=19860206;

a=(((FromDigits[Take[Join[Table[0,{8-Length[IntegerDigits[a]]}],IntegerDigits[a]] ,{3,6}]]))^2)

Holubecz Judit

m=12345678;h=8;J={m};
For[i=2,i≤h,i++,
k=Characters[ToString[m^2]];
k1={};
For[j=IntegerPart[Length[s]/2] -3,j<=IntegerPart[Length[k]/2]+4,j++,k1=Append[k1,k[[j]] ] ];
k1=FromDigits[StringJoin[k1]];
J=Append[J,k1];
m=k1;
]

J

Homoki Tibor

Véletlen szám generálása Neumann János módszere alapján: veszünk egy n jegyű számot, ennek középső jegyeit négyzetre emeljük és így megkapjuk a véletlen számot. Pl. n=4 esetén:

f[x_]:=(((RealDigits[Random[Integer,{1000,9999}]][[1]][[2]]*10+RealDigits[Random[Integer,{1000,9999}]][[1]][[3]]))^2)

f[x]

Kiss Ágnes

Megoldáshoz kellett

n=1234

If[EvenQ[Length[IntegerDigits[n]]/2],t=Take[IntegerDigits[n],{Length[IntegerDigits[n]]/2-Floor[Length[IntegerDigits[n]]/2/2]+1,Length[IntegerDigits[n]]/2+Floor[Length[IntegerDigits[n]]/2/2]}],t=Take[IntegerDigits[n],{Length[IntegerDigits[n]]/2-Floor[Length[IntegerDigits[n]]/2/2],Length[IntegerDigits[n]]/2+Floor[Length[IntegerDigits[n]]/2/2]}]]

berak[list_,1]:=Reverse[Append[Reverse[list],0]]
berak[list_,n_]:=Reverse[Append[Reverse[berak[list,n-1]],0]]

If[Length[IntegerDigits[FromDigits[t]^2]]==Length[IntegerDigits[n]],l1=IntegerDigits[FromDigits[t]^2],l1=berak[IntegerDigits[FromDigits[t]^2],Length[IntegerDigits[n]]-Length[IntegerDigits[FromDigits[t]^2]]]]

FromDigits[l1]

n=1234

FromDigits[l1]

Érthetőbben, de hosszabban:

n= 10023000

l=IntegerDigits[n]

k=Length[l]/2

If[EvenQ[k],t=Take[l,{k-Floor[k/2]+1,k+Floor[k/2]}],t=Take[l,{k-Floor[k/2],k+Floor[k/2]}]]

m=FromDigits[t]

If[Length[IntegerDigits[m^2]]==Length[l],l1=IntegerDigits[m^2],l1=berak[IntegerDigits[m^2],Length[l]-Length[IntegerDigits[m^2]]]]

FromDigits[l1]

Megoldás maga

berak[list_,1]:=Reverse[Append[Reverse[list],0]]
berak[list_,n_]:=Reverse[Append[Reverse[berak[list,n-1]],0]]

n=4453223456

neu[1]=n;
neu[k_]:=If[Length[IntegerDigits[FromDigits[If[EvenQ[Length[IntegerDigits[neu[k-1]]]/2],Take[IntegerDigits[neu[k-1]],{Length[IntegerDigits[neu[k-1]]]/2-Floor[Length[IntegerDigits[neu[k-1]]]/2/2]+1,Length[IntegerDigits[neu[k-1]]]/2+Floor[Length[IntegerDigits[neu[k-1]]]/2/2]}],Take[IntegerDigits[neu[k-1]],{Length[IntegerDigits[neu[k-1]]]/2-Floor[Length[IntegerDigits[neu[k-1]]]/2/2],Length[IntegerDigits[neu[k-1]]]/2+Floor[Length[IntegerDigits[neu[k-1]]]/2/2]}]]]^2]]==Length[IntegerDigits[neu[k-1]]],IntegerDigits[FromDigits[If[EvenQ[Length[IntegerDigits[neu[k-1]]]/2],Take[IntegerDigits[neu[k-1]],{Length[IntegerDigits[neu[k-1]]]/2-Floor[Length[IntegerDigits[neu[k-1]]]/2/2]+1,Length[IntegerDigits[neu[k-1]]]/2+Floor[Length[IntegerDigits[neu[k-1]]]/2/2]}],Take[IntegerDigits[neu[k-1]],{Length[IntegerDigits[neu[k-1]]]/2-Floor[Length[IntegerDigits[neu[k-1]]]/2/2],Length[IntegerDigits[neu[k-1]]]/2+Floor[Length[IntegerDigits[neu[k-1]]]/2/2]}]]]^2],berak[IntegerDigits[FromDigits[If[EvenQ[Length[IntegerDigits[neu[k-1]]]/2],Take[IntegerDigits[neu[k-1]],{Length[IntegerDigits[neu[k-1]]]/2-Floor[Length[IntegerDigits[neu[k-1]]]/2/2]+1,Length[IntegerDigits[neu[k-1]]]/2+Floor[Length[IntegerDigits[neu[k-1]]]/2/2]}],Take[IntegerDigits[neu[k-1]],{Length[IntegerDigits[neu[k-1]]]/2-Floor[Length[IntegerDigits[neu[k-1]]]/2/2],Length[IntegerDigits[neu[k-1]]]/2+Floor[Length[IntegerDigits[neu[k-1]]]/2/2]}]]]^2],Length[IntegerDigits[neu[k-1]]]-Length[IntegerDigits[FromDigits[If[EvenQ[Length[IntegerDigits[neu[k-1]]]/2],Take[IntegerDigits[neu[k-1]],{Length[IntegerDigits[neu[k-1]]]/2-Floor[Length[IntegerDigits[neu[k-1]]]/2/2]+1,Length[IntegerDigits[neu[k-1]]]/2+Floor[Length[IntegerDigits[neu[k-1]]]/2/2]}],Take[IntegerDigits[neu[k-1]],{Length[IntegerDigits[neu[k-1]]]/2-Floor[Length[IntegerDigits[neu[k-1]]]/2/2],Length[IntegerDigits[neu[k-1]]]/2+Floor[Length[IntegerDigits[neu[k-1]]]/2/2]}]]]^2]]]]

neu[2]

neum[1]=n;
neum[k_]:=FromDigits[neu[k]]

neum[2]

(Valamiért háromnál nagyobb számokra nem működik - a neu függvény miatt, de nem tudok rájönni, hogy hol rossz.)

Lelkes Ádám

A NextRandom függvény azt csinálja, hogy az argumentumként kapott szám négyzetének tizes számrendszerbeli alakjában veszi a középső kb. 1/3 számjegyet.

NextRandom[r_]:=Floor[Mod[r^2,10^(Floor[Log[10,r^2]*2/3]+1)]/10^(Floor[Log[10,r^2]/3]-1)]

NestList[NextRandom,123456,20]

NestList[NextRandom,123456,200]

Nagy László

1. feladat
p=123456789;
h=8;
L={k};
For[i=2,i≤h,i++,
s=Characters[ToString[k^2]];
s1={};
For[j=IntegerPart[Length[s]/2] -3,j<=IntegerPart[Length[s]/2]+4,j++,s1=Append[s1,s[[j]] ] ];
s1=FromDigits[StringJoin[s1]];
L=Append[L,s1];
p=s1;
]
L

Pallag Mónika

a=1213141516;
b=5;
list={a};
For[i=2,i≤b,i++,c=Characters[ToString[a^2]];
d={};
For[j=IntegerPart[Length[c]/2]-3,j≤IntegerPart[Length[c]/2]+4,j++,d=Append[d,c[[j]]]];
d=FromDigits[StringJoin[d]];
list=Append[list,d];
a=d;]
list

Palej Gréta

t=123456;
z=8;

L={t};
For[i=2,i≤z,i++,
s=Characters[ToString[t^2]];
s1={};
For[j=IntegerPart[Length[s]/2] -3,j<=IntegerPart[Length[s]/2]+4,j++,s1=Append[s1,s[[j]] ] ];
s1=FromDigits[StringJoin[s1]];
L=Append[L,s1];
t=s1;
]
L

Pap Máté

k=12584231;
h=8;
L={k};
i=2;
While[i≤h,
s=Characters[ToString[k^2]];
s1={};
For[j=IntegerPart[Length[s]/2] -3,j<=IntegerPart[Length[s]/2]+4,j++,s1=Append[s1,s[[j]] ] ];
s1=FromDigits[StringJoin[s1]];
L=Append[L,s1];
k=s1;
i++;
]
L

Szép Enikő

"Anyone who considers arithmetical methods of producing random digits is, of course, in a state of sin." /Neumann/ :)

PRNG[seed_,l_,n_]:=
NestList[If[Length[#]<l,PadRight[#,l,1],#]&@(If[Length[#]>l,Drop[#,{l+1,-1}],#]&@(Take[If[Length[#]<l,PadRight[#,l,1],#]&@IntegerDigits[FromDigits[#]^2],{(Floor[(Length[#]/2)]-(Floor[(Length[#]/2)]-Floor[l/2]-1)),(Ceiling[(Length[#]/2)]-(Ceiling[(Length[#]/2)]+Ceiling[l/2]))}]))&,seed,n]

Manipulate[
Module[{res=PRNG[SeedRandom[seed];RandomInteger[{0,9},l],l,12]},
Column[{
Column[{Text[Style["seed state:","Label"]],
ArrayPlot[{SeedRandom[seed];RandomInteger[{0,9},l]},Mesh->True,ImageSize->{350,100}]},Alignment->Center],Column[{Text[Style["middle-square generated sequences:","Label"]],ArrayPlot[res[[2;;m+1]],Mesh->True,ImageSize->{350,250}]},Alignment->Center]
}
]
],
{{l,10,"sequence length"},4,12,1,Appearance->"Labeled"},
{{m,1,"iterations"},1,12,1,Appearance->"Labeled"},
{{seed,0},Button["random",seed=RandomInteger[1000]]&},
SaveDefinitions->True,AutorunSequencing->{1,2}]

Torma Lídia Boglárka

a=674838;
p=6;
La={a};
For[k=2,k≤p,k++,
b=Characters[ToString[a^2]];
ba={};
For[l=IntegerPart[Length[b]/2] -3,l<=IntegerPart[Length[b]/2]+2,l++,ba=Append[ba,b[[l]] ] ];
ba=FromDigits[StringJoin[ba]];
La=Append[La,ba];
a=ba;
]
La

Varga Gábor

k=12345678;
h=8;
L={k};
For[i=2,i≤h,i++,
s=Characters[ToString[k^2]];
s1={};
For[j=IntegerPart[Length[s]/2] -3,j<=IntegerPart[Length[s]/2]+4,j++,s1=Append[s1,s[[j]] ] ];
s1=FromDigits[StringJoin[s1]];
L=Append[L,s1];
k=s1;
]
L

2. feladat

2. Készítsünk táblázatot az első 12 szabályos sokszögről, írjuk a belsejükbe az oldalak számát és a szomszédos oldalak bezárta szöget.

Antos Kató

{Range[3,14],Table[(180*(n-2))/n,{n,3,14}]}//MatrixForm

Bartha Zsolt

Row[Table[Graphics[{Text["dfdfd"],EdgeForm[Black],Orange,Polygon[Table[{-Sin[(π/n)-((2 i π)/n)],-Cos[(π/n)-((2 i π)/n)]},{i,0,n-1}]],Black,Inset[n-szög,{0,-0.3}],Inset[(180.0-360.0/n) "°"]}],{n,3,12}]]

Fekete Samu

l=Range[3,12]

TableForm[Map[List[#,Pi-2Pi/#]&,l]]

Forberger Klaudia

Grid[{Table[i ,{i,3,12}],Table[180*(i-2)/i,{i,3,12}]},Frame->All]

g[x_]:=Polygon[Table[{Cos[2 Pi s 1/x],Sin[2 Pi s 1/x]},{s,x}]]

Grid[{Table[i ,{i,3,12}],Table[180*(i-2)/i,{i,3,12}],Table[Graphics[{EdgeForm[{Thin,Black}],FaceForm[LightMagenta],g[n]},ImageSize->50],{n,3,12}]},Frame->All]

Grid[{Table[Graphics[{EdgeForm[{Thin,Black}],FaceForm[LightMagenta],g[i],Text[i,{0,0.2} ],Text[N[180(i-2)/i] ,{0,-0.2}]},ImageSize->70],{i,3,12}]},Frame->All]

Geszler Döme

Table[Graphics[{White,EdgeForm[Thick],Polygon@@{Table[{Cos[((2k Pi)/i)],Sin[((2k Pi)/i)]},{k,0,i-1}]},Inset[Style[N[180 (i-2)/i]"°",Black],{0,-0.1}],Inset[Style[i,Black],{0,0.1}]}],{i,3,14}]

Holubecz Judit

(*Nem tudtam egy táblázatba beletenni az ábrákat és a számokat is, ezért két táblázatot küldök.*)

MatrixForm[Grid[{Range[3,14],Table[180*(k-2)/k,{k,3,14}]}]]

Table[Graphics[Polygon[Table[{Cos[2π l/(k+1)],Sin[2π l/(k+1)]},{l,0,k}]]],{k,Range[1,13]}]

Homoki Tibor

Manipulate[
Style[Column[{
Item[{"Szabályos háromszög","Négyzet","Szabályos ötszög","Szabályos hatszög","Szabályos hétszög","Szabályos nyolcszög","Szabályos kilencszög","Szabályos tízszög","Szabályos tizenegyszög","Szabályos tizenkétszög"}[[n-2]],ItemSize->{Automatic,1.1}],
Graphics[{EdgeForm[Black],Polygon[Table[{-Sin[(π/n)-((2 i π)/n)],-Cos[(π/n)-((2 i π)/n)]},{i,0,n-1}]]},
PlotRange->1,ImageSize->{500,300}],
Row[{n, " oldal"}],Row[{(n-2)/n*180, " fokos szögek"}]},Center],"Label",20],
{{n,3,"oldalak száma"},3,12,1}]

Kiss Ágnes

deg[n_]:=N[(n-2) 180 / n]

ngon[p_]:=Polygon[Table[{Cos[2 Pi k /p],Sin[2 Pi k 1/p]},{k,p}]]

Table[Graphics[{EdgeForm[Black],LightGreen,ngon[j],Black,Text[Csúcs:j,{0,0.25}],Text[Szög:deg[j]"°",{0,0}]},ImageSize-> 110],{j,3,12}]

Kovács Luca Zsuzsanna

ngon[p_]:=Polygon[Table[{Cos[2Pi k/p],Sin[2Pi k/p]},{k,p}]]
Table[Graphics[{EdgeForm[Black],White,ngon[n],Black,Text[ n csúcs,{0,0}],Text[Szög: N[180-360/n ] fok,{0,-0.2}]}],{n,3,12}]

Lelkes Ádám

Table[Graphics[{LightGray,EdgeForm[Black],Polygon[Table[{-Sin[(π/n)-((2 i π)/n)],-Cos[(π/n)-((2 i π)/n)]},{i,0,n-1}]],Black,Inset[n- szög,{0,.5}],Inset[(180-360/n)°]}],
{n,3,14}]

Palej Gréta

Table[Graphics[Polygon[Table[{Cos[2π k/(i+1)],Sin[2π k/(i+1)]},{k,0,i}]]],{i,Range[1,13]}]

MatrixForm[Grid[{Range[3,14],Table[180*(x-2)/x,{x,3,14}]}, Frame->All]]

Pallag Mónika

MatrixForm[{Range[3,14],Table[180*(n-2)/n,{n,3,14}]}]

Pap Máté

Table[Graphics[Polygon[Table[{Cos[2π k/(i+1)],Sin[2π k/(i+1)]},{k,0,i}]]],{i,Range[1,13]}]

Papp János

sokszog[p_]:=Polygon[Table[{3Cos[2Pi k/p],3Sin[2Pi k/p]},{k,p}]]
szog[n_]:=(N[180-360/n])
Table[Graphics[{EdgeForm[Red],White,sokszog[n],Black,Text[Csúcs: n,{0,0}],Text[Szög: szog[n]"°",{0,-0.5}]}],{n,3,12}]

Podonyi Anikó

sokszog[p_,q_]:=Polygon[Table[{Cos[2Pi k q/p],Sin[2Pi k q/p]},{k,p}]]
Row[Table[Framed[Graphics[{EdgeForm[Black],White,sokszog[n,1]},ImageSize->170]],{n,3,14}]]

Szép Enikő

Table[Graphics[{LightGray,EdgeForm[Black],Hue[RandomReal[]],Opacity[.6],Polygon[Table[{-Sin[(π/n)-((2 i π)/n)],-Cos[(π/n)-((2 i π)/n)]},{i,0,n-1}]], Black,Inset[n- szög,{0,.4}],Inset[(180-360/n)°]}],
{n,3,14}]

Torma Lídia Boglárka

MatrixForm[Grid[{Range[3,14],Table[180*(i-2)/i,{i,3,14}]}, Frame->All]]

Varga Gábor

Table[Graphics[Polygon[Table[{Cos[2π k/(i+1)],Sin[2π k/(i+1)]},{k,0,i}]]],{i,Range[1,13]}]

3. feladat

3. Mozgó átlagot és egymás utáni párokat készítsünk másképpen, többféleképpen. (MovingAverage, MovingMedian, ListConvolve, ListCorrelate; Partition, LeftRotate, Inner)

Fekete Samu

movingaverage[l_,r_]:=Flatten[Join[List[Mean@l[[1;;r]],movingaverage[Drop[l,1],r]]]] /;r<Length[l]
movingaverage[l_,r_]:=Mean@l/; r==Length[l]

movingaverage[{1,2,3,4},2]

movingaverage[Range[22],5]

listconvolve[ker_,l_]:=Join[List[Plus@@(Reverse[l[[1;;Length[ker]]]]*ker)],listconvolve[ker,Drop[l,1]]] /;Length[ker]<Length[l]
listconvolve[ker_,l_]:=List[Plus@@(Reverse[l]*ker)] /;Length[ker]==Length[l]

ClearAll[x,y,a,b,c];listconvolve[{x,y},{a,b,c}]

parosit[l1_,l2_]:=Join[List[List[First[l1],First[l2]]],parosit[Rest[l1],Rest[l2]]] /;Length[l1]==Length[l2] && Length[l1]>1
parosit[l1_,l2_]:=List[Join[l1,l2]] /; Length[l1]==Length[l2] && Length[l1]==1

parosit[{1,2,3},{3,4,5}]

inner[f_,l1_,l2_,g_]:=g@@(f@@@parosit[l1,l2])

inner[Times,{a,b,c},{x,y,z},Plus]

Kovács Luca Zsuzsanna

MAtlag[l_,n_]:=(Eredmeny={};
For[i=1,i≤Length[l]-n+1,i++,Eredmeny=Append[Eredmeny,(Plus@@Take[l,{i,i+n-1}])/n];];
Eredmeny)

MAtlag[Range[22],5]

Papp János

MovAve[l_List,r_Integer]:=(MAlist={};i=0;While[i+r<=Length[l],partlist=Partition[Drop[l,i],r];MAlist=Append[MAlist,(Plus@@partlist[[1]])/r];i++;];
MAlist)

ClearAll[a,b,c,d,e,f];
MovAve[{a,b,c,d,e,f},4]

Podonyi Anikó

MovingAverage[{1,2,3,4,5,6},2]

MovingMedian[{1,2,3,4,5,6},2]

ListConvolve[{1,2},{1,2,3,4,5,6}]

ListCorrelate[{1,2},{1,2}]

Inner[Times,{1,2},{1,2},Plus]

Partition[{1,2,3,4,5,6},2]

Torma Lídia Boglárka

MovingAverage[{1,2,3,4,5}, 2]

MovingMedian[{2,2,4,6,2,4,6},2]

ListConvolve[{{1/2,1/2}},{{3,3,4},{5,3,1},{3,2,7}}]

ListCorrelate[{{1/2,1/2},{1/2,1/2}},{{1,2,3},{2,3,4},{2,3,6}}]

Partition[{1,2,2,3,3,4, 4, 5},2]

Inner[#/2&,{a,b, c, d},{1,1, 1, 1}]

4. feladat

4. Írjunk fordított Fold-ot (Haskell: foldr) és FoldList-et. Mikor ad azonos eredményt Fold és FoldR?

Bartha Zsolt

ClearAll[foldr,foldrlist,f,x0,list, a, b, c];
foldr[f_, x0_, {}]:=x0
foldr[f_, x0_, list_]:=f[list[[1]],foldr[f, x0, list[[2;;]]]]
foldrlist[f_, x0_, list_]:=Table[foldr[f, x0, list[[i;;]]],{i,Length[list]+1,1,-1}]

foldr[f, x0, {}]

foldr[f, x0, {a,b,c}]

foldrlist[f, x0, {a,b,c}]//TableForm

Fold[f, x0, {a,b,c}]

A Fold és a foldr akkor ad azonos eredményt, ha az f függvény (művelet) asszociatív, illetve az x0 kiindulási érték felcserélhető bármely másik számmal (az f műveletre nézve).

Forberger Klaudia

FoldR[f_,x_,l_]:=Fold[f[#2,#1]&,x,l]

FoldR[f,x,{a,b,c,d}]

De a listát meg kell fordítani!

FoldRList[f_,x_,l_]:=FoldList[f[#2,#1]&,x,l]

FoldRList[f,x,{a,b,c,d}]

Geszler Döme

FoldR[f_,x_,list_]:= Fold[f[#2,#1]&,x,list]
FoldRList[f_,x_,list_]:= FoldList[f[#2,#1]&,x,list]

Kiss Ágnes

FoldR[f_,x_,list_]:=Fold[f[#2,#1]&,x,list]

FoldR[g,x,{a,b,c,d}]

FoldRList[f_,x_,list_]:=FoldList[f[#2,#1]&,x,list]

FoldRList[g,x,{a,b,c,d}]

FoldR[g,x,{a,b,c,d}]

Kovács Luca Zsuzsanna

ForditottFL[f_,x_,l_]:=(Lista={x};i=1;While[i≤Length[l],
Lista=Append[Lista,f[Lista[[-1]],l[[-i]]]];i++;];
Lista)
ForditottFL2[f_,x_,l_]:=FoldList[f,x,Reverse[l]]

FoldR[f_,x_,l_]:=Last[ForditottFL[f,x,l]]
FoldR2[f_,x_,l_]:=Fold[f,x,Reverse[l]]

Fold és FoldR azonos eredményt ad, ha olyan listára hívjuk meg, aminek a fordítottja önmaga.

Lelkes Ádám

FoldR[f_, x_, {}]:=x
FoldR[f_, x_, list_]:=f[list[[1]],FoldR[f, x,list[[2;;]]]]

FoldR[f,x,{a,b,c,d}]

Papp János

foldlistr[ff_,x_,l_List]:=(
fl={x};
n=1;
While[n≤Length[l],
fl=Append[fl,ff[fl[[-1]],l[[-n]]]];
n++;];
fl)
foldr[ff_,x_,l_List]:=foldlistr[ff,x,l][[-1]]

foldlistr[f,x,{a,b,c,d,e}]

foldr[f,x,{a,b,c,d,e}]

Fold[f,x,{a,b,c,b,a}]
foldr[f,x,{a,b,c,b,a}]

A Fold és a FoldR akkor egyezik meg, ha a függvény, a változó ugyanaz, és a lista pedig szimmetrikus, azaz az i. és -i. elem megegyezik.

Szép Enikő

FoldR[x_, y_, {}]:=y
FoldR[x_, y_, list_]:=x[list[[1]],FoldR[x, y,list[[2;;]]]]

FoldR[x,y,{a,b,c,d}]