VPF::Сортировка методом "пузырька" - Форум программистов

kostyaizznu

Дата 5.11.2008, 23:04 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 88
Регистрация: 30.10.2008
Где: Запорожье

Репутация: нет
Всего: нет

Привет, ребята, помогите, пожалуйста разобраться в простой задаче сортировки пузырьком.

Вот текст программы, которая должна разобрать текст по словам с порядковыми номерами,записав их в промежуточный файл, затем отсортировать слова по алфавиту. Сойдёт, если сначала будут заглавные, потом строчные. Разбор тескта выполняется, кажется нормально, а с сортировкой что-то не так.

Код


{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+}
{$M 16384,0,655360}

  program lab1;
  uses crt;
     type mytype=record
          num:integer;
          mas:string[20];
     end;
  var

     f1,f2:text;
     t,i,j,n,k,tek,z,p,q:integer;
     sym:char;
     s,s1,s2:string;
     rez:boolean;
     a:array[1..2700] of mytype;
     b,c,d,e:longint;
     label l1,l2,l3,l4,lb2,lb4,lb1;

function  cmp(s1:string;s2:string):boolean;
      var
          i,n:integer;
          a,b,c,d:longint;
begin
{--------------------------------------------------------------------------}
{Sravnivaem dlinu strok i dopisyvaem probely}

      if length(s1)<>length(s2) then begin

          if length(s1)<length(s2) then begin
             n:=length(s2)-length(s1);
             for i:=1 to n do s1:=s1+' ';
          end;

          if length(s1)>length(s2) then begin
             n:=length(s1)-length(s2);
            for i:=1 to n do s2:=s2+' ';
          end;
      end;
writeln('Pervoe slovo--------#',s1,'#');
writeln('Vtoroe slovo--------#',s2,'#');
{---------------------------------------------------------------------------}
{sravnim dva slova}
 for i:=1 to length(s1) do begin

     a:=ord(s1[i]); b:=ord(s2[i]);

       end;

     if i<>length(s1) then begin c:=ord(s1[i+1]); d:=ord(s2[i+1]); end

     else c:=0; d:=1;

      if (a>b) and (c=d) then begin  cmp:=true; break; end;
      if (a<b) then begin cmp:=false; break; end;
      if (a=b) and (i=length(s1)) then begin cmp:=false; break; end;
      if (a=b) and (i<>length(s1)) then

 end;                        


end;



begin

clrscr;
{---------------------------------------------------------------------------}
{Perezapis sortiruemyh elementov v promejut. fayl}
  i:=0;
  s:='';
  assign (f1,'1.txt');
  reset (f1);
  assign(f2,'2.txt');
  rewrite(f2);
  while not eof(f1) do begin

      l1:
      read(f1,sym);

      if ( (ord(sym)>127)) then begin
      s:=s+sym;
      goto l1;
     end;

 l2:
     if (ord(sym)=26) then goto l4;
     if (length(s)=0) then goto l1;

     writeln(f2,s);
     s:='';

 end;
l4:
close(f1);
close(f2);

{---------------------------------------------------------------------------}
{Chast' vtoraya: perezapis}

assign (f1, '2.txt');
reset(f1);
assign (f2, '3.txt');
rewrite(f2);
i:=1;
while not EOF(f1) do begin
readln(f1,s);
a[i].mas:=s;
a[i].num:=i;
i:=i+1;
end;
close(f1);
n:=i-1;
for i:=1 to n do begin
writeln(f2,a[i].num,' ',a[i].mas);
end;
close(f2);
z:=n;
{---------------------------------------------------------------------------}
{part 3 puzyri}
s:='';

    for j:=1 to z-1 do begin

              for i:=1 to z-j do begin

                  rez:=cmp(a[i].mas,a[i+1].mas);
                    if rez then begin

                     s:='';s:=a[i].mas;
                     a[i].mas:=a[i+1].mas;
                     a[i+1].mas:=s;
                     tek:=a[i].num; a[i].num:=a[i+1].num;
                     a[i+1].num:=tek;
                     end;
                   readln;
              end;
    end;


assign (f1, '4.txt');
rewrite(f1);
   for i:=1 to z  do begin
     writeln(f1,a[i].num,'  ',a[i].mas);
   end;
close(f1);
writeln('Sortirovka proshla uspeshno');
readln;

end.

Помогите отладить, пожалуйста.

Тегами пользуйся...

Это сообщение отредактировал(а) volvo877 - 5.11.2008, 23:05

volvo877

Дата 5.11.2008, 23:21 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 2
Всего: 116

А что, просто:

Код


var T: mytype;
...
{part 3 puzyri}
    s:='';
    for j:=1 to z-1 do begin
              for i:=1 to z-j do begin
                  if a[i].mas > a[i+1].mas then begin
                    T := a[i]; a[i] := a[i + 1]; a[i + 1] := T;
                    readln;
              end;
    end;

написать никак нельзя? Обязательно надо заниматься глупостями и сравнивать строки посимвольно? Программу полностью не смотрел и не собираюсь (не переношу меток и кодирования в стиле Бейсика)...

kostyaizznu

Дата 10.11.2008, 18:51 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 88
Регистрация: 30.10.2008
Где: Запорожье

Репутация: нет
Всего: нет

Спасибо

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Object Pascal: кроссплатформенные технологии \| Следующая тема »