Witam
Mam do zrobienia projekt sortowanie leksykograficzne. Znalazlem takie srotowanie w internecie, dorobilem co mi bylo potrzebne i sortuje tak jak powinien. Ale mam problem, bo musze znac nazwe sortowania jakiego użyłem, (bo jak wiadomo sortowanie leksykograficzne można zrobić na kilka sposobów), może ktoś bedzie wiedział jak to sortowanie sie nazywa ??
I jeszcze jeden problem, jak zliczyć ilość przestawień i porównań w tym sortowaniu, męcze sie nad tym, wstawialem liczniki, ale to jest jakieś dziwne sortowanie i nie wiem jak to zliczyc. Byłbym bardzo wdzięczny za pomoc i z góry dziękuję.
Program jest robiony pod konsola Delphi, nie w czystym pascalu
program leks;
{$APPTYPE CONSOLE}
uses
SysUtils;
const
n=1000;
type
tab=array[1..n] of string;
tleks=array['`'..'z',1..n] of string;
var
a:tab;
ilosc,dl:integer;
procedure wczytaj(var g:tab; var il:integer; var d:integer);
var
i:integer;
BEGIN
writeln('Ile lancuchow:');
readln(il);
writeln('Podaj lancuchy');
d:=0;
for i:=1 to il do
begin
readln(g[i]);
if length(g[i])>d then
d:=length(g[i]);
end;
writeln(dl);
END;
procedure dopelnienie(var a:tab; il:integer; d:integer);
var
i: integer;
begin
for i:=1 to il do
while length(a[i])<d do
a[i]:=a[i]+'`';
end;
procedure wypisz(a:tab; ilosc:integer);
var
i:integer;
begin
for i:=1 to ilosc do
write(a[i],' ');
end;
procedure generuj(var g:tab; var il:integer; var d:integer);
var i,j,ile2:integer;
begin
randomize;
writeln('ile chcesz wygenerowac wyrazow');
readln(il);
writeln('ile liter');
readln(ile2);
d:=0;
for j:=1 to il do
begin
for i:=1 to ile2 do
begin
a[j]:=a[j]+chr(random(26)+97);
end;
if length(a[j])>d then d:=length(a[j]);
write(a[j]);
write(' ');
end;
//writeln('dlugosc ',d);
end;
procedure czysc(var a:tleks);
var
j:integer;
i:char;
begin
for i:='`' to 'z' do
for j:=1 to n do
a[i,j]:='2';
end;
procedure przepisz(p:tleks; var r:tab);
var
i,h:integer;
g:char;
begin
i:=1;
for g:='`' to 'z' do
for h:=1 to n do
if p[g,h]<>'2' then
begin
r[i]:=p[g,h];
i:=i+1;
end;
end;
procedure sortowanie(var a:tab; il:integer; d:integer);
var
i,j,s,zlicz,zlicz1:integer;
q:tleks;
begin
zlicz:=0;
zlicz1:=0;
//for i:=dl downto 1 do <-wedlug mnie to jest niepotrzebne
begin
czysc(q);
s:=1;
j:=1;
i:=1;
while j<=ilosc do
begin
if q[a[j,i],s]='2' then
begin
q[a[j,i],s]:=a[j];
j:=j+1;
end
else
begin
s:=s+1;
zlicz1:=zlicz1+1;
end;
end;
przepisz(q,a);
end;
end;
procedure menu;
var ch:char;
begin
repeat
begin
writeln('1 - Wpisz recznie: ');
writeln('2 - Wygeneruj automatycznie');
writeln;
readln(ch);
case ch of
'1' : begin
wczytaj(a,ilosc,dl);
dopelnienie(a,ilosc,dl);
sortowanie(a,ilosc,dl);
writeln;
wypisz(a,ilosc);
readln;
end;
'2' : begin
generuj(a,ilosc,dl);
dopelnienie(a,ilosc,dl);
sortowanie(a,ilosc,dl);
writeln;
wypisz(a,ilosc);
readln;
end;
'3' : begin
writeln;
end;
'0' : begin
writeln;
end;
end;
end;
until ch<>'0';
end;
BEGIN
menu;
END.