VPF::Сортировка двупутевым слиянием.

Rencom

Дата 22.5.2006, 14:20 (ссылка)

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

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 77
Регистрация: 27.9.2005

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

Задача: ввести N слов в массив, элементы массива записать в файл, отсортировать файл внешней сортировкой двупутевым слиянием по признаку - количество гласных буквв слове, поместить из файла отсортированные данные в массив, результат вывести на экран. Среда Borland Pascal 7.0.

Проблемы: Массив выводится лесенкой почему-то. Не могу понять почему.

Код


Program SortWorld;

Uses Crt;

Const
  _FILE0_='file0.txt';
  N=6; { number of words }

Type
  TElem    = record
               name : string;
               count: integer
             end;
  TFile    = file of TElem;
  TArray   = array[1..N] of TElem;
  TSequence= record
               f      : TFile;
               elem   : TElem;
               eof,eor:boolean
             end;

Var
  File0     : TFile;
  InputArray: TArray;
  i         : word;

Procedure Input;
  var
    buffer   : char;
    i,j      : word;
  begin
    for i:=1 to N do
        begin
          write('Word #',i,': ');
          j:=0; InputArray[i].name:='';
          read(buffer);
          while buffer <> #13 do
                begin
                  IF buffer in ['A','a','E','e','I','i','O','o','U','u','Y','y']
                       then
                         inc(j);
                  InputArray[i].name:=InputArray[i].name+buffer;
                  read(buffer)
                end;
          InputArray[i].count:=j
        end
  end;
Procedure GetToFile;
  var i     :word;
      buffer:TElem;
  begin
    assign(File0,_FILE0_);
    rewrite(File0);
    for i:=1 to N do
        begin
          buffer:=InputArray[i];
          write(File0,buffer)
        end;
    close(File0)
  end;
Procedure OutputFile;
  var buffer:TElem;
      i: word;
  begin
    assign(File0,_File0_);
    reset(File0); i:=0;
    while not eof(File0) do
          begin
            inc(i);
            read(File0,InputArray[i])
          end;
    close(File0);
    for i:=1 to N do
        begin
          write(InputArray[i].name,' - ',InputArray[i].count)
        end
  end;
Procedure OpenSeq(var s:TSequence; fn: string);
  begin
    assign(s.f,fn)
  end;
Procedure ReadNext (var s:TSequence);
  begin
    s.eof:=eof(s.f);
    if not s.eof then read(s.f,s.elem)
  end;
Procedure StartRead(var s:TSequence);
  begin
    reset(s.f);
    ReadNext(s);
    s.eor:=s.eof
  end;
Procedure StartWrite(var s:TSequence);
  begin
    rewrite(s.f)
  end;
Procedure CloseSeq(var s:TSequence);
  begin
    close(s.f)
  end;
Procedure Copy(var x,y:TSequence);
  begin
    y.elem:=x.elem;
    write(y.f,y.elem);
    ReadNext(x);
    x.eor:=x.eof or (x.elem.count<y.elem.count)
  end;
Procedure CopyRun(var x,y:TSequence);
  begin
    repeat
      Copy(x,y)
    until x.eor
  end;
Procedure Distribute(var f0,f1,f2:TSequence);
  begin
    StartRead(f0); StartWrite(f1); StartWrite(f2);
    while not f0.eof do
          begin
            CopyRun(f0,f1);
            if not f0.eof then CopyRun(f0,f2)
          end;
    CloseSeq(f0); CloseSeq(f1); CloseSeq(f2)
  end;
Procedure Marge(var f0,f1,f2:TSequence; var count:integer);
  begin
    StartRead(f1); StartRead(f2); StartWrite(f0);
    count:=0;
    while not f1.eof and not f2.eof do
          begin
            while not f1.eor and not f2.eor do
                  if f1.elem.count<=f2.elem.count
                     then
                       Copy(f1,f0)
                     else
                       Copy(f2,f0);
            if not f1.eor then CopyRun(f1,f0);
            if not f2.eor then CopyRun(f2,f0);
            f1.eor:=f1.eof;
            f2.eor:=f2.eof;
            inc(count)
          end;
    while not f1.eof do
          begin
            CopyRun(f1,f0);
            inc(count)
          end;
    while not f2.eof do
          begin
            CopyRun(f2,f0);
            inc(count)
          end;
    CloseSeq(f1); CloseSeq(f2); CloseSeq(f0)
  end;

Procedure Sort(FileName: string);
  var
    f0,f1,f2:TSequence;
    count:integer;
  begin
    OpenSeq(f0,filename); OpenSeq(f1,'temp1'); OpenSeq(f2,'temp2');
    repeat
      Distribute(f0,f1,f2);
      Marge(f0,f1,f2,count)
    until count <=1;

    Erase(f1.f); Erase(f2.f)
  end;

Begin
  ClrScr;
  Input;
  GetToFile;
  ClrScr;
  writeln('Before sorting:');
  OutputFile;
  Sort(_File0_);
  writeln; writeln('After sorting:');
  OutputFile;
  Erase(File0);
  readln
End.

Snowy

Дата 22.5.2006, 14:58 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

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

Вероятно потому, что ты для вывода используешь Write, а за разделитель считаешь #13.
А после #13 в текстовом файле идет #10, которая и вызывает сдвиг на строку ниже.

Rencom

Дата 22.5.2006, 17:46 (ссылка)

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

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 77
Регистрация: 27.9.2005

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

Как тогда считывать строку в массив, чтобы ее ввод заканчивался нажатием <Enter>?

volvo877

Дата 22.5.2006, 20:41 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(Rencom @ 22.5.2006, 17:46

)

Как тогда считывать строку в массив

Пропускать #10 (не заносить этот символ в строку) :

Код

Procedure Input;
var
  buffer   : char;
  i,j      : word;
begin
  for i:=1 to N do begin
    write('Word #',i,': ');
    j:=0; InputArray[i].name:='';
    read(buffer);

    while buffer <> #13 do begin
      IF buffer in ['A','a','E','e','I','i','O','o','U','u','Y','y']
      then inc(j);

      if buffer <> #10 then { <--- !!! }
        InputArray[i].name:=InputArray[i].name+buffer;
      read(buffer)
    end;

    InputArray[i].count:=j
  end
end;

Только тогда тебе придется в OutputFile делать не Write, а Writeln:

Код


Procedure OutputFile;
var
    buffer:TElem;
    i: word;
begin
    assign(File0,_File0_);
    reset(File0); i:=0;
    while not eof(File0) do
          begin
            inc(i);
            read(File0,InputArray[i])
          end;
    close(File0);
    for i:=1 to N do
        begin
          writeLN(InputArray[i].name,' - ',InputArray[i].count) { <--- Здесь ! }
        end
end;

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