Cod sursa(job #124793)

Utilizator andreivFMI - vacaroiu andrei andreiv Data 19 ianuarie 2008 21:36:50
Problema Ordine Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.97 kb
program ordine;
var v:array[1..1000] of integer;
    i,j,n:longint;
    ok:boolean;
    s:array[-100..10000000] of string[1];


procedure citire;
var f:text;
    c:char;
begin
assign(f,'ordine.in');
reset(f);
while not eoln(f) do
begin
read(f,c);
v[ord(c)-96]:=v[ord(c)-96]+1;
end;
closE(f);
end;


procedure afisare;
var g:text;
    aux:string;
begin
assign(g,'ordine.out');
rewrite(g);
for i:=2 to n-1 do
if (s[i]=s[i-1]) or (s[i]=s[i+1]) then
begin
 for j:=1 to n do
 if (s[j-1]<>s[i]) and (s[j+1]<>s[i]) and (s[j]<>s[i]) then
 begin
 aux:=s[i];
 s[i]:=s[j];
 s[j]:=aux;
 end;

if (s[i]=s[i-1]) or (s[i]=s[i+1]) then
begin
write(g,s[i]);
s[i]:='';
end;
end;



for i:=1 to n do
write(g,s[i]);
closE(g);
end;

begin
citire;
n:=0;
ok:=true;
while ok do
begin
ok:=false;
for i:=1 to 27 do
if v[i]<>0 then
begin
v[i]:=v[i]-1;
n:=n+1;
s[n]:=chr(i+96);
end;
for i:=1 to 27 do
if v[i]<>0 then
ok:=true;
end;
afisare;
end.