Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 15.06.2008, 16:56   #1
Taisja
Пользователь
 
Регистрация: 31.05.2008
Сообщений: 25
Печаль Не могу понять почему не идет сортировка файла, помогите пожалуйста

Сортировка файла с возвратом на один шаг после обмена.
Просматривают файл до тех пор, пока не обнаружится, что первый элемент пары больше второго. В этом случае элементы пары меняются местами, и просмотр продолжают с предыдущего (обработанного на предыдущем шаге) элемента файла. Сортировку завершают, когда файл просмотрен до конца.


procedure TForm1.Button1Click(Sender: TObject);
var
f:file of integer;
a,b,i,n,t,k:integer;
begin
assignfile(f,'1.txt');
n:=strtoint(edit1.text);
rewrite(f);
for i:=1 to n do
begin t:=Random(100);
write(f,t);
memo1.Lines.Add(inttostr(t));
end;
closefile(f);
k:=0;
for i:=1 to n-1 do
reset(f);
while not eof(f) or (k<n-2) do
begin
read(f,a);
read(f,b);
if a>b then begin
seek(f,(filepos(f))-2);
write(f,b);
write(f,a);
seek(f,(filepos(f))-1);
k:=k+1;
end;
end; closefile(f);
end;

reset(f);
while not eof(f) do
begin
read(f,a);
memo2.Lines.Add(inttostr(a));
end;
end;

end.
Taisja вне форума Ответить с цитированием
Старый 15.06.2008, 17:42   #2
alexBlack
Участник клуба
 
Регистрация: 12.10.2007
Сообщений: 1,204
По умолчанию

Цитата:
Сообщение от Taisja Посмотреть сообщение
Сортировка файла с возвратом на один шаг после обмена.
Этот Ваш вариант ближе к описанному алгоритму, но не совсем то.

Код:
procedure TForm1.Button1Click(Sender: TObject);
var f:file of integer;
    pos, a, b, i, n, t:integer;
    S:STring;
begin
   Memo1.lines.clear;
   assignfile(f,'1.txt');
   n := 9; //n := strtoint(edit1.text);
   rewrite(f);
   S := '';
   for i:=1 to n do begin
      t:=Random(100);
      write(f,t);
      S := S + inttostr(t) + ' '
   end;
   memo1.Lines.Add(S);

   seek(f, 0);
   while filepos(f) <= N-2 do begin
      read(f,a);
      read(f,b);
      seek(f, filepos(f)-1); // Следующая пара чисел
      if a > b then begin
         // на позицию назад для записи
         seek(f, filepos(f)-1);
         write(f,b);
         write(f,a);
         // к предыдущей паре
         pos := filepos(f)-3;
         if pos < 0 then pos := 0;
         seek(f, pos);
         continue;
      end;
   end;
   closefile(f);

   assignfile(f,'1.txt');
   reset(f);
   S := '';
   while not eof(f) do begin
      read(f,a);
      S := S + intToStr(a) + ' ';
   end;
   memo2.Lines.Add(S);
end;
alexBlack вне форума Ответить с цитированием
Старый 15.06.2008, 20:37   #3
Taisja
Пользователь
 
Регистрация: 31.05.2008
Сообщений: 25
По умолчанию

Огромнейшее СПАСИБО!!! Вы меня спасли.
Taisja вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Не могу понять в чем проблема (код) diznt Помощь студентам 2 03.08.2008 10:20
Не могу понять почему вылетает 3 процедурка, помогите Taisja Помощь студентам 2 04.06.2008 21:28
Помогите пожалуйста не могу понять! Kosoy135 Паскаль, Turbo Pascal, PascalABC.NET 7 28.12.2007 19:08
не могу понять... Dutchman Паскаль, Turbo Pascal, PascalABC.NET 4 14.12.2006 07:14