15.10.2019, 05:35 [+3 UTC]
в нашей команде: 3 883 чел. | участники онлайн: 1 (рекорд: 21)

:: РЕГИСТРАЦИЯ

задать вопрос

все разделы

правила

новости

участники

доска почёта

форум

блоги

поиск

статистика

наш журнал

наши встречи

наша галерея

отзывы о нас

поддержка

руководство

Версия системы:
7.77 (31.05.2019)
JS-v.1.34 | CSS-v.3.35

Общие новости:
28.04.2019, 09:13

Форум:
11.10.2019, 14:47

Последний вопрос:
14.10.2019, 21:36
Всего: 150595

Последний ответ:
15.10.2019, 02:42
Всего: 259215

Последняя рассылка:
14.10.2019, 18:15

Писем в очереди:
0

Мы в соцсетях:

Наша кнопка:

RFpro.ru - здесь вам помогут!

Отзывы о нас:
28.07.2019, 17:48 »
dar777
Это самое лучшее решение! [вопрос № 196025, ответ № 278436]
11.10.2009, 22:30 »
ghost32
Спасибо большое, все работает! [вопрос № 173159, ответ № 255286]

РАЗДЕЛ • Pascal / Delphi / Lazarus

Создание программ на языках Pascal, Delphi и Lazarus.

[администратор рассылки: Зенченко Константин Николаевич (Старший модератор)]

Лучшие эксперты в этом разделе

zdwork
Статус: 6-й класс
Рейтинг: 736
Зенченко Константин Николаевич
Статус: Старший модератор
Рейтинг: 202
puporev
Статус: Профессионал
Рейтинг: 56

Перейти к консультации №:
 

Консультация онлайн # 196467
Раздел: • Pascal / Delphi / Lazarus
Автор вопроса: rail (Посетитель)
Отправлена: 27.09.2019, 10:05
Поступило ответов: 1

Здравствуйте, уважаемые эксперты! Прошу вас ответить на следующий вопрос:

Разработать алгоритм сортировки естественным слиянием. Отсортировать с помощью него
массив.

pascal

Приложение:

Состояние: Консультация закрыта

Здравствуйте, rail!

Внешняя сортировка - естественное слияние.

Код (Pascal) :: выделить код
const
  n0:string='inpData.dat';
  n1:string='File1st.dat';
  n2:string='File2nd.dat';
  a:array[1..16]of integer=(59,30,99,28,27,87,65,98,25,29,92,88,73,84,81,41);
type
  tF=file of integer;
var
  f0,f1,f2:tF;{}
  a1,a2:integer;{}
  b:boolean;
  c1,c2:integer;{}
begin
  assign(f0,n0);assign(f1,n1);assign(f2,n2);
  rewrite(f0);
  for c1:=1 to 16 do write(f0,a[c1]);
  close(f0);
  repeat
    reset(f0);rewrite(f1);rewrite(f2);
    read(f0,a1,a2);b:=true;
    repeat
      if b then write(f1,a1) else write(f2,a1);
      if a1>a2 then b:= not b;
      a1:=a2;
      read(f0,a2);
    until EOF(f0);
    if b then write(f1,a1) else write(f2,a1);
    if a1>a2 then b:=not b;
    if b then write(f1,a2) else write(f2,a2);
    close(f0);close(f1);close(f2);
  {}
    writeln('control output before sort:');
    reset(f0);reset(f1);reset(f2);
    write(FileSize(f0):6,' ':3);while not EOF(f0)do begin read(f0,a1);write(a1:3)end;writeln;
    write(FileSize(f1):6,' ':3);while not EOF(f1)do begin read(f1,a1);write(a1:3)end;writeln;
    write(FileSize(f2):6,' ':3);while not EOF(f2)do begin read(f2,a1);write(a1:3)end;writeln;
    c1:=FileSize(f1);c2:=FileSize(f2);
    close(f0);close(f1);close(f2);
    if(c1<>0)and(c2<>0)then
      begin
        rewrite(f0);reset(f1);reset(f2);
        while(not EOF(f1))and(not EOF(f2))do
          begin
            c1:=-32768;c2:=-32768;
            read(f1,a1);read(f2,a2);
            while(c1<=a1)and(c2<=a2)and(not EOF(f1))and(not EOF(f2))do
              if a1<=a2 then
                begin
                  write(f0,a1);
                  c1:=a1;
                  read(f1,a1)
                end
                else
                  begin
                    write(f0,a2);
                    c2:=a2;
                    read(f2,a2)
                  end;
            while(c1<=a1)and(not EOF(f1))do
              begin
                write(f0,a1);
                c1:=a1;
                read(f1,a1)
              end;
            while(c2<=a2)and(not EOF(f2))do
              begin
                write(f0,a2);
                c2:=a2;
                read(f2,a2)
              end;
            while not EOF(f1)do
              begin
                write(f0,a1);
                read(f1,a1)
              end;
            while not EOF(f2)do
              begin
                write(f0,a2);
                read(f2,a2)
              end;
            if a1<=a2 then write(f0,a1,a2)
                      else write(f0,a2,a1);
          end;
        close(f0);close(f1);close(f2);
        reset(f0);reset(f1);reset(f2);
        writeln('control output after sort');
        write(FileSize(f0):6,' ':3);while not EOF(f0)do begin read(f0,a1);write(a1:3)end;writeln;
        write(FileSize(f1):6,' ':3);while not EOF(f1)do begin read(f1,a1);write(a1:3)end;writeln;
        write(FileSize(f2):6,' ':3);while not EOF(f2)do begin read(f2,a1);write(a1:3)end;writeln;
        c1:=FileSize(f1);c2:=FileSize(f2);
        close(f0);close(f1);close(f2);
      end
  until(c1=0)or(c2=0);
end.

Удачи!


Консультировал: Зенченко Константин Николаевич (Старший модератор)
Дата отправки: 03.10.2019, 15:08

Рейтинг ответа:

+1

[подробно]

Сообщение
модераторам

Отправлять сообщения
модераторам могут
только участники портала.
ВОЙТИ НА ПОРТАЛ »
регистрация »

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

Яндекс Rambler's Top100

главная страница | поддержка | задать вопрос

Время генерирования страницы: 0.14587 сек.

© 2001-2019, Портал RFPRO.RU, Россия
Калашников О.А.  |  Гладенюк А.Г.
Версия системы: 7.77 от 31.05.2019
Версия JS: 1.34 | Версия CSS: 3.35