18.01.2020, 02:50 [+3 UTC]
в нашей команде: 4 150 чел. | участники онлайн: 5 (рекорд: 21)

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

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

все разделы

правила

новости

участники

доска почёта

форум

блоги

поиск

статистика

наш журнал

наши встречи

наша галерея

отзывы о нас

поддержка

руководство

Версия системы:
7.80 (15.01.2020)
JS-v.1.35 | CSS-v.3.36

Общие новости:
06.01.2020, 22:45

Форум:
13.01.2020, 16:40

Последний вопрос:
18.01.2020, 02:32
Всего: 151434

Последний ответ:
17.01.2020, 19:30
Всего: 259652

Последняя рассылка:
18.01.2020, 00:15

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

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

Наша кнопка:

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

Отзывы о нас:
19.04.2010, 07:03 »
Миронычев Виталий
Спасибо вам огромное за труд!!! [вопрос № 177908, ответ № 260907]

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

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

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

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

Gluck
Статус: Студент
Рейтинг: 505
Зенченко Константин Николаевич
Статус: Старший модератор
Рейтинг: 284
puporev
Статус: Профессионал
Рейтинг: 147

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

Консультация онлайн # 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.17279 сек.

© 2001-2020, Портал RFPRO.RU, Россия
Калашников О.А.  |  Гладенюк А.Г.
Версия системы: 7.80 от 15.01.2020
Версия JS: 1.35 | Версия CSS: 3.36