Cod sursa(job #1140075)

Utilizator ili226Vlad Ilie ili226 Data 11 martie 2014 18:35:56
Problema Ordine Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.92 kb
program ordine;
var fin,fout:text;
    cuv,cuv2:string;
    min:char;
    i,k,poz,lungime:byte;
procedure quick(pin,psf:byte);
var a,b,m:byte;aux:char;
begin
a:=pin;b:=psf;m:=(a+b)div 2;
repeat
while cuv[a]<cuv[m]do inc(a);
while cuv[b]>cuv[m]do dec(b);
if a<=b then
 begin
  aux:=cuv[a];cuv[a]:=cuv[b];cuv[b]:=aux;
  inc(a);dec(b);
 end;
until a>=b;
if b>pin then quick(pin,b);
if a<psf then quick(a,psf);
end;
begin
assign(fin,'ordine.in');reset(fin);
readln(fin,cuv);close(fin);lungime:=length(cuv);
quick(1,length(cuv));i:=1;k:=1;
cuv2:=cuv[1];cuv:=copy(cuv,2,length(cuv)-1);
repeat
if cuv[i]<>cuv2[k] then begin cuv2:=cuv2+cuv[i];inc(k);
                              cuv:=copy(cuv,1,i-1)+copy(cuv,i+1,length(cuv)-i);
                              i:=1;
                        end
                   else inc(i);
until k=lungime;
assign(fout,'ordine.out');rewrite(fout);
write(fout,cuv2);close(fout);
end.