Az alábbi letöltési lehetőségek közül választhatsz: (
segítség)
Típus: text/plain
Tartalmaz szöveget
Karakterkódolás: us-ascii
Méret: 4 KB
program anagramma;
type pelem=^elem;
plelem=^lelem;
lelem=record
adat :string;
kov :plelem;
end;
lista=record
farok :plelem;
fej :plelem;
db :longint;
kulcs :string;
end;
elem=record
bal :pelem;
jobb :pelem;
list :lista;
end;
fa=record
gyoker :pelem;
end;
var f,ff :fa;
mut1,tmp1 :pelem;
e :lista;
o1 :longint;
t2 :text;
function skulcs(s2 :string) :string;
var i,j,o,n :longint;
c :char;
s :string;
begin
s:=s2;
n:=length(s);
o:=1;
while o=1 do
begin
o:=0;
for i:=1 to n-1 do
begin
if s[i]>s[i+1] then
begin
c:=s[i];
s[i]:=s[i+1];
s[i+1]:=c;
o:=1;
end;
end;
end;
skulcs:=s;
end;
procedure llista(var l :lista);
begin
l.db:=0;
new(l.fej);
new(l.farok);
l.farok^.kov:=nil;
l.farok^.adat:='';
l.fej^.kov:=l.farok;
l.fej^.adat:='';
l.kulcs:='';
end;
procedure blista(st :string; var l:lista);
var mut,tmp :plelem;
begin
mut:=l.fej;
new(tmp);
tmp^.adat:=st;
tmp^.kov:=mut^.kov;
mut^.kov:=tmp;
l.db:=l.db+1;
end;
procedure klista(l: lista);
var mut :plelem;
begin
mut:=l.fej^.kov;
while mut<>l.farok do
begin
writeln(t2,mut^.adat);
mut:=mut^.kov;
end;
end;
procedure kfa;
var mut :pelem;
tmp :pelem;
s,k :string;
t :text;
l :lista;
o :longint;
begin
assign(t,'anagramma.be');
reset(t);
readln(t,s);
llista(l);
k:=skulcs(s);
blista(s,l);
new(f.gyoker);
f.gyoker^.list:=l;
f.gyoker^.list.kulcs:=k;
f.gyoker^.bal:=nil;
f.gyoker^.jobb:=nil;
while not eof(t) do
begin
readln(t,s);
k:=skulcs(s);
mut:=f.gyoker;
o:=0;
while o=0 do
begin
if mut^.list.kulcs=k then
begin
blista(s,mut^.list);
o:=1;
mut:=nil;
end
else if mut^.list.kulcs>k then
begin
if mut^.bal<>nil then mut:=mut^.bal
else o:=2;
end
else
begin
if mut^.jobb<>nil then mut:=mut^.jobb
else o:=3;
end;
end;
if o>1 then
begin
llista(l);
new(tmp);
blista(s,l);
tmp^.list:=l;
tmp^.list.kulcs:=k;
tmp^.jobb:=nil;
tmp^.bal:=nil;
if o=2 then mut^.bal:=tmp else mut^.jobb:=tmp;
end;
end;
close(t);
end;
procedure ujfa;
var mut :pelem;
tmp :pelem;
l :lista;
begin
new(ff.gyoker);
ff.gyoker^.list.db:=0;
llista(l);
ff.gyoker^.list:=l;
ff.gyoker^.bal:=nil;
ff.gyoker^.jobb:=nil;
ff.gyoker^.list.kulcs:='';
end;
procedure bejar(mut :pelem);
var o2 :longint;
begin
if mut<>nil then
begin
if mut^.bal<>nil then
begin
bejar(mut^.bal);
end;
e:=mut^.list;
mut1:=ff.gyoker;
o1:=0;
while o1=0 do
begin
if mut1^.list.db>=e.db then
begin
if mut1^.bal<>nil then mut1:=mut1^.bal
else o1:=2;
end
else if mut1^.jobb<>nil then mut1:=mut1^.jobb
else o1:=3;
end;
if o1>1 then
begin
new(tmp1);
tmp1^.list:=e;
tmp1^.jobb:=nil;
tmp1^.bal:=nil;
if o1=2 then mut1^.bal:=tmp1 else mut1^.jobb:=tmp1;
end;
if mut^.jobb<>nil then
begin
bejar(mut^.jobb);
end;
end;
end;
procedure bejar2(mut :pelem);
var o :longint;
begin
if mut<>nil then
begin
if mut^.bal<>nil then
begin
bejar2(mut^.bal);
end;
writeln(t2,mut^.list.db);
writeln(t2,mut^.list.kulcs);
klista(mut^.list);
if mut^.jobb<>nil then
begin
bejar2(mut^.jobb);
end;
end;
end;
begin
kfa;
ujfa;
assign(t2,'anagramma.ki');
rewrite(t2);
bejar(f.gyoker);
bejar2(ff.gyoker);
close(t2);
end.
