pic=Function[w,
ListPlot[w,
Axes->None,
Frame->True,
AspectRatio->1,
PlotStyle->PointSize[0.5/Length[w]]
]
];

%%%%%%%%%%%%%%%%%

<<"Combinatorica`"

lista10=RandomPermutation[10]

%%%%%%%%%%%%%%%%%

permutationsort=Function[w,Module[{all,i,ok,sortedQ},
sortedQ=Function[u,Module[{k,j,fine},
k=Length[u];
j=1;
fine=True;
While[fine&&j<k,
If[u[[j]]≤u[[j+1]],j=j+1,fine=False]
];
fine
]];

all=Permutations[w];
i=1;
ok=False;
While[!ok,
If[sortedQ[all[[i]]],ok=True,i=i+1]
];
all[[i]]
]];

Timing[permutationsort[lista10]]

%%%%%%%%%%%%%%%%%

luckysort=Function[w,Module[{u,ok,sortedQ},
sortedQ=Function[u,Module[{k,j,fine},
k=Length[u];
j=1;
fine=True;
While[fine&&j<k,
If[u[[j]]≤u[[j+1]],j=j+1,fine=False]
];
fine
]];

ok=False;
u=w;
While[!ok,
If[sortedQ[u],ok=True,u=RandomPermutation[u]]
];
u
]];

Timing[luckysort[lista10]]

%%%%%%%%%%%%%%%%%

insertionsort=Function[w,Module[{s,i,j,k,e,ok,film},
k=Length[w];
s={};
i=1;
film={pic[Join[s,w]]};
While[i≤k,
e=w[[i]];
j=i-1;
ok=False;
While[j≥1&&!ok,
If[e≥s[[j]],ok=True,j=j-1]
];
s=Insert[s,e,j+1];
film=Append[film,pic[Join[s,Drop[w,i]]]];
i=i+1
];
Print[s];
ListAnimate[film]
]];

insertionsort[lista10]

lista200=RandomPermutation[200];

insertionsort[lista200]

pureinsertionsort=Function[w,Module[{s,i,j,k,e,ok},
k=Length[w];
s={};
i=1;
While[i≤k,
e=w[[i]];
j=i-1;
ok=False;
While[j≥1&&!ok,
If[e≥s[[j]],ok=True,j=j-1]
];
s=Insert[s,e,j+1];
i=i+1
];
s]];

Timing[pureinsertionsort[lista200]]

%%%%%%%%%%%%%%%

selectsort=Function[w,Module[{s,m,i,k,j,u,e,pm,film},
k=Length[w];
u=w;
s={};
i=1;
film={pic[Join[s,u]]};
While[i≤k,
m=Infinity;
j=1;
While[j≤1+k-i,
e=u[[j]];
If[e<m,m=e;pm=j];
j=j+1
];
s=Append[s,m];
u=Delete[u,pm];
film=Append[film,pic[Join[s,u]]];
i=i+1
];
Print[s];
ListAnimate[film]
]];

selectsort[lista200]

pureselectsort=Function[w,Module[{s,m,i,k,j,u,e,pm},
k=Length[w];
u=w;
s={};
i=1;
While[i≤k,
m=Infinity;
j=1;
While[j≤1+k-i,
e=u[[j]];
If[e<m,m=e;pm=j];
j=j+1
];
s=Append[s,m];
u=Delete[u,pm];
i=i+1
];
s]];

Timing[pureselectsort[lista200]]

%%%%%%%%%%%%%%%

quicksort=Function[w,Module[{split,qaux,film},
split=Function[u,Module[{af,f,df,i,k,n},
f=u[[1]];
af={};
df={};
i=2;
k=Length[u];
While[i≤k,
n=u[[i]];
If[n<f,af=Append[af,n],df=Append[df,n]];
i=i+1
];
{af,f,df}]];
qaux=Function[{ctxe,u,ctxd},Module[{e,x,d,lll},
film=Append[film,pic[Join[ctxe,u,ctxd]]];
If[Length[u]<2,u,
{e,x,d}=split[u];
lll=qaux[ctxe,e,Join[{x},d,ctxd]];Join[lll,{x},qaux[Join[ctxe,lll,{x}],d,ctxd]]
]]];

film={pic[w]};
Print[qaux[{},w,{}]];
ListAnimate[film]
]];

quicksort[lista200]

purequicksort=Function[w,Module[{split,e,x,d,k},
split=Function[f,Module[{af,df,i,n},
af={};
df={};
i=2;
While[i≤k,
n=w[[i]];
If[n<f,af=Append[af,n],df=Append[df,n]];
i=i+1
];
{af,f,df}]];

k=Length[w];
If[k<2,w,
{e,x,d}=split[w[[1]]];
Join[purequicksort[e],{x},purequicksort[d]]
]
]];

Timing[purequicksort[lista200]]

impqsort=Function[w,Module[{split,r,stack,cw,len,x,e,d},
split=Function[u,Module[{f,k,af,df,i,n},
f=u[[1]];
k=Length[u];
af={};
df={};
i=2;
While[i≤k,
n=u[[i]];
If[n<f,af=Append[af,n],df=Append[df,n]];
i=i+1
];
{af,f,df}]];

r={};
stack={w};
While[stack≠{},
cw=First[stack];
stack=Rest[stack];
len=Length[cw];
If[len==1,r=Append[r,cw[[1]]],
If[len>1,
{e,x,d}=split[cw];
stack=Join[{e,{x},d},stack]
]]
];
r
]];

Timing[impqsort[lista200]]

%%%%%%%%%%%%%%%

mergesort=Function[w,Module[{u,msort,merge,film},
merge=Function[{e,c,d},Module[{ee,cc,dd,x,y},
ee=e;cc=c;dd=d;
While[ee≤cc&&cc<dd,
x=u[[ee]];
y=u[[cc+1]];
If[x<y,ee=ee+1,
u=Insert[Delete[u,cc+1],y,ee];
film=Append[film,pic[u]];
ee=ee+1;cc=cc+1
]
]
]];
msort=Function[{e,d},Module[{c},
If[e<d,
c=Floor[(e+d)/2];
msort[e,c];
msort[c+1,d];
merge[e,c,d]
]
]];

u=w;
film={pic[u]};
msort[1,Length[w]];
Print[u];
ListAnimate[film]
]];

mergesort[lista200]

puremergesort=Function[w,Module[{u,msort,merge},
merge=Function[{e,c,d},Module[{ee,cc,dd,x,y},
ee=e;cc=c;dd=d;
While[ee≤cc&&cc<dd,
x=u[[ee]];
y=u[[cc+1]];
If[x<y,ee=ee+1,
u=Insert[Delete[u,cc+1],y,ee];
ee=ee+1;cc=cc+1
]
]
]];
msort=Function[{e,d},Module[{c},
If[e<d,
c=Floor[(e+d)/2];
msort[e,c];
msort[c+1,d];
merge[e,c,d]
]
]];

u=w;
msort[1,Length[w]];
u
]];

Timing[puremergesort[lista200]]

impmsort=Function[w,Module[{u,k,merge,stack,e,c,d,t},
merge=Function[{e,c,d},Module[{ee,cc,dd,x,y},
ee=e;cc=c;dd=d;
While[ee≤cc&&cc<dd,
x=u[[ee]];
y=u[[cc+1]];
If[x<y,ee=ee+1,
u=Insert[Delete[u,cc+1],y,ee];
ee=ee+1;cc=cc+1
]
]
]];

u=w;
t=0;
k=Length[u];
stack={{1,k}};
While[stack≠{},
{e,d}=First[stack];
If[e==d,t=d;stack=Rest[stack],
c=Floor[(e+d)/2];
If[e<d&&d>t,stack=Join[{{e,c},{c+1,d}},stack],
merge[e,c,d];stack=Rest[stack]]
]
];
u
]];

Timing[impmsort[lista200]]

%%%%%%%%%%

countingsort=Function[{w},Module[{max,min,cnt,k,r,i,j,t},
min=Min[w];
max=Max[w];
k=Length[w];
cnt=Table[0,{t,min,max}];
i=1;
While[i≤k,
cnt[[w[[i]]-min+1]]=cnt[[w[[i]]-min+1]]+1;
i=i+1
];
r={};
i=1;
While[i≤max-min+1,
r=Join[r,Table[i+min-1,{cnt[[i]]}]];
i=i+1
];
r
]];

Timing[countingsort[lista200]]

%%%%%%%%%

Timing[Sort[lista200]]