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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 14.06.2008, 23:51   #1
Taisja
Пользователь
 
Регистрация: 31.05.2008
Сообщений: 25
Печаль Помогите переделать файловую сортировку на сортировку динамич. списков

Сортировку файла я сделала, сортировка динамических списков такая же, с ней я не могу справиться.Помогите пожалуйста решить сортировку динамических списков, в понедельник сдавать, на грани вылета из ВУЗа, осталась эта последняя задача и я - спасена.
Условие:
Сортировка динамического списка с возвратом на один шаг после обмена.
Просматривают динамический список до тех пор, пока не обнаружится, что первый элемент пары больше второго. В этом случае элементы пары меняются местами, и просмотр продолжают с предыдущего (обработанного на предыдущем шаге) элемента динамического списка. Сортировку завершают, когда динамический список просмотрен до конца.
(задачка на файл)
var
Form1: TForm1;
sim:string;
fname:string;
fS:textfile;
implementation
{$R *.dfm}
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
If OpenDialog1.Execute then
If OpenDialog1.Filename<>'' Then
Begin
fname:=OpenDialog1.Filename;
Form1.StaticText1.Caption:=(fname);
AssignFile(FS, fname);
{$i-}
Reset(FS);
{$i+}
if IOResult<> 0 then Begin
ShowMessage('Ошибка в открытии файла '+fname);
exit;
End;
readln(FS,sim);
CloseFile(FS);
if Length(sim)>0 then Button1.Enabled:=True;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Flag:boolean;
Temp:char;
i:integer;
begin
repeat
Flag := False;
for i := 0 to Length(sim)-1 do
if sim[i] > sim[i + 1] then begin
Temp := Sim [i];
Sim [i] := Sim [i + 1];
Sim [i + 1] := Temp;
Flag := True;
end;
until Flag = False;
fname:=fname+'_res.txt';
AssignFile(FS, fname);
{$i-}
Rewrite(FS);
{$i+}
if IOResult<> 0 then Begin
ShowMessage('Ошибка Записи файла '+fname);
exit;
End;
Writeln(FS,sim);
CloseFile(FS);
label1.Caption:='Записан файл результатов '+fname;
Button1.Enabled:=false;
end;
end.
Taisja вне форума Ответить с цитированием
Старый 15.06.2008, 09:52   #2
alexBlack
Участник клуба
 
Регистрация: 12.10.2007
Сообщений: 1,204
По умолчанию

Цитата:
Сообщение от Taisja Посмотреть сообщение
Сортировку файла я сделала, сортировка динамических списков такая же, с ней я не могу справиться.
Можно было сделать хотя-бы заполнение списка.
То, что Вы сделали для файлов, это не сортировка с возвратом.

Код:
type
  PNode = ^TNode;
  TNode = record
     data : integer;
     prev, next : PNode;
  end;

  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
     Head : PNode;
     procedure ViewList(Head:PNode);
     procedure Sort(var Head:PNode);
  public
  end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ViewList(Head:PNode);
var E:PNode;
    S:String;
begin
   S := '|'; E := Head;
   while E <> nil do begin
      S := S + '-> '+intToStr(E.data)+' <-';
      E := E.next;
   end;
   memo1.Lines.add(S+'|');
end;

procedure TForm1.Sort(var Head:PNode);
var E1, E2:PNode;
    tp, tn:PNode;
begin
   if Head = nil then exit;
   E1 := Head;
   while E1.next <> nil do begin
      if E1.data > E1.next.data then begin
         E2 := E1.next;

         // E1 <> E2
         tp := E1.prev;          //  <--tp- E1 <---> E2 --tn-->
         tn := E2.next;

         if tn <> nil then tn.prev := E1;
         if tp <> nil
         then tp.next := E2
         else head := E2;

         E1.next := tn;
         E1.prev := E2;
         E2.next := E1;
         E2.prev := tp;

         ViewList(Head); //

         // Возврат на шаг назад
         if tp <> nil then E1 := tp;
         continue;
      end;
      E1 := E1.next;
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var E:PNode;
    i:integer;
begin
   // Заполнение списка случайными числами
   randomize;
   for i:=1 to 10 do begin
      new(E);
      E.Data := random(100);
      E.prev := nil;
      E.next := nil;

      if Head = nil
      then Head := E
      else begin
         E.next := Head;
         Head.prev := E;
         Head := E;
      end;
   end;

   ViewList(Head);
   Sort(Head);
   ViewList(Head);

   // Удаление списка
   while Head <> nil do begin
      E := Head.next;
      dispose(Head);
      Head := E;
   end;
end;
alexBlack вне форума Ответить с цитированием
Старый 15.06.2008, 16:10   #3
Taisja
Пользователь
 
Регистрация: 31.05.2008
Сообщений: 25
По умолчанию

Большое-прибольшое спасибо за задачку!
А что же не так с сортировкой файла? Помогите пожалуйста разобраться, завтра сдавать. Вопрос жизни и смерти, я не шучу.
Taisja вне форума Ответить с цитированием
Ответ


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

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Задача на сортировку... Sota Помощь студентам 4 25.05.2008 19:26
Про сортировку AlexMori Общие вопросы Delphi 3 11.01.2008 01:51
Задача на сортировку массива Acid Паскаль, Turbo Pascal, PascalABC.NET 1 17.06.2007 00:16