Wealth Distribution Model with
Constant Transfer and Constant Wealth

NN = 400;
TT  =  1000;
MM  =  100;

    
wealths  =  Table[2.4, {NN}];
logwealths = 
Table[
Log[{i, Reverse[Sort[wealths]][[i]]}], {i, 1, 
            NN}
];
ListPlot[
logwealths, 
PlotRange -> {All, {-9.9, 3.9}}, 
Prolog -> {PointSize[
              0.015], Thickness[0.005]}, 
PlotStyle -> 
          RGBColor[1, 0, 
            0], 
AxesStyle  ->  {Thickness[
              0.005]}
];
Do[
Do[
x  =  
            Random[Integer, {1, NN}]; 
y  =  
            Random[Integer, {1, NN}]; 
delta  =  
            Random[]; 
If[
wealths[[y]] >  
              0.6 + delta, 
wealths  =  
ReplacePart[wealths, wealths[[x]] + delta, 
                x]; 
wealths  =  
ReplacePart[wealths, wealths[[y]] - delta, 
                y]
], 
{m, 1, 
            MM}
]; 
logwealths  =  
Table[
Log[{i, Reverse[
                    Sort[wealths]][[i]]}], {i, 1, 
              NN}
]; 
ListPlot[
logwealths, 
PlotRange -> {All, {-9.9, 3.9}}, 
Prolog -> {PointSize[0.015], 
              Thickness[0.005]}, 
PlotStyle -> 
            RGBColor[1, 0, 
              0], 
AxesStyle  ->  {Thickness[
                0.005]}
], 
{t, 1, 
          TT}
];