Отправляет email-рассылки с помощью сервиса Sendsay

RFpro.ru: Программирование на Delphi и Lazarus

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 3.312 RSS
←   Октябрь 2019   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31


За последние 60 дней ни разу не выходила


Сайт рассылки: http://rusfaq.ru/
Открыта: 14-03-2002

Автор
Калашников О.А.

Статистика

3.312 подписчиков
0 за неделю
←   Все выпуски   →

RFpro.ru: Программирование на Delphi и Lazarus


РАССЫЛКИ ПОРТАЛА RFPRO.RU

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

zdwork
Статус: 5-й класс
Рейтинг: 317
∙ повысить рейтинг » 		puporev
Статус: Профессионал
Рейтинг: 30
∙ повысить рейтинг » 		Сучкова Татьяна Михайловна
Статус: Мастер-Эксперт
Рейтинг: 1
∙ повысить рейтинг »

∙ Pascal / Delphi / Lazarus

Номер выпуска:1778
Дата выхода:07.10.2019, 10:15
Администратор рассылки:Зенченко Константин Николаевич (Старший модератор)
Подписчиков / экспертов:33 / 36
Вопросов / ответов:2 / 3

Консультация # 196466: Здравствуйте! Прошу помощи в следующем вопросе: Реализовать алгоритм сортировки прямым слиянием. Размер массива задаёт пользователь. Вывести на экран исходный и отсортированный массивы. PascalABC smile ...
Консультация # 196467: Здравствуйте, уважаемые эксперты! Прошу вас ответить на следующий вопрос: Разработать алгоритм сортировки естественным слиянием. Отсортировать с помощью него массив. pascal ...

Консультация # 196466:

Здравствуйте! Прошу помощи в следующем вопросе:

Реализовать алгоритм сортировки прямым слиянием. Размер массива задаёт пользователь.
Вывести на экран исходный и отсортированный массивы.

PascalABC
smile

Дата отправки: 27.09.2019, 10:01
Вопрос задал: Satana666 (Посетитель)
Всего ответов: 2
Страница онлайн-консультации »

Консультирует zdwork (5-й класс):

Здравствуйте, Satana666!
Попробуйте ТАК...

Код (Pascal) :: выделить код
program SortSlian;
uses crt;
type mas=array[1..1000] of integer;
procedure Sliv(var a:mas;p,q : integer);
{процедура сливающая массивы, p-начало, q-конец}
var r,i,j,k : integer;
    b:mas;
begin
 r:=(p+q) div 2;{делим массив}
 i:=p;{начало левой половины}
 j:=r+1;{начало правой половины}
 for k:=p to q do{смотрим от начала до конца}
 if (i<=r) and ((j>q) or (a[i]<a[j])) then
 {переставляем элементы из половин в новый массив, упорядочивая пары}
  begin
   b[k]:=a[i];
   i:=i+1;
  end
 else
  begin
   b[k]:=a[j];
   j:=j+1;
  end ;
 for k:=p to q do
 a[k]:=b[k];
end;
{рекурсивная процедура сортировки, проверяет если осталось
больше одного элемента, повторяет слияние в левой или правой частях массива}
procedure Sort(var a:mas;p,q : integer); {p,q - индексы начала и конца сортируемой части массива}
begin
 if p<q then {массив из одного элемента тривиально упорядочен}
 begin
  Sort(a,p,(p+q) div 2);{сортируем левую половину}
  Sort(a,(p+q) div 2 + 1,q);{правую половину}
  Sliv(a,p,q);{сливаем две половины}
 end;
end;
var a:mas;
    n,i:integer;
begin
 clrscr;
 randomize;
 write('Размер массива n=');
 readln(n); {Определение размера массива A - N) и его заполнение}
 writeln('Исходный массив:');
 for i:=1 to n do
  begin
   a[i]:=random(50);
   write(a[i],' ');
  end;
 writeln;
 writeln;
 {запуск сортирующей процедуры, сортируем от первого до последнего элемента}
 Sort(a,1,N);
 {Вывод отсортированного массива A}
 writeln('Результат сортировки:');
 for i:=1 to n do
 write(a[i],' ');
 readln
end.

Консультировал: zdwork (5-й класс)
Дата отправки: 27.09.2019, 11:53
Рейтинг ответа:

НЕ одобряю +1 одобряю!

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

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

Правильный код:внешней сортировки-прямым слиянием.

Код (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;{рабочие переменные}
  c,c0,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]);
  c:=FileSize(f0);
  close(f0);
  c0:=1;
  while c0<c do
    begin
      reset(f0);rewrite(f1);rewrite(f2);
      writeln('range:',c0:3,':');
      c1:=0;
      while(not EOF(f0))and(c1<(c div 2))do begin read(f0,a1);write(f1,a1);inc(c1)end;
      while not EOF(f0)do begin read(f0,a1);write(f2,a1)end;
      close(f0);close(f1);close(f2);
      writeln('control output before sort:');
      reset(f0);reset(f1);reset(f2);
      while not EOF(f0)do begin read(f0,a1);write(a1:3)end;writeln;
      while not EOF(f1)do begin read(f1,a1);write(a1:3)end;writeln;
      while not EOF(f2)do begin read(f2,a1);write(a1:3)end;writeln;
      close(f0);close(f1);close(f2);
      rewrite(f0);reset(f1);reset(f2);
      while(not EOF(f1))and(not EOF(f2)) do
        begin
          c1:=c0;c2:=c0;
          read(f1,a1);read(f2,a2);
          while(c1>0)and(c2>0)do
            begin
              if a1<=a2 then begin write(f0,a1);dec(c1);if c1>0 then read(f1,a1)end
                        else begin write(f0,a2);dec(c2);if c2>0 then read(f2,a2)end;
            end;
          if c1>0then begin while(c1>1)and(not EOF(f1))do begin write(f0,a1);read(f1,a1);dec(c1)end;write(f0,a1)end;
          if c2>0then begin while(c2>1)and(not EOF(f2))do begin write(f0,a2);read(f2,a2);dec(c2)end;write(f0,a2)end;
        end;
      close(f0);close(f1);close(f2);
      writeln('control output after sort:');
      reset(f0);
      while not EOF(f0) do begin read(f0,a1);write(a1:3)end;writeln;
      close(f0);
      c0:=c0*2;
    end;
end.

Котрольный массив затдан в соответсвии с GIF в минифоруме, для контроля.
Получается такой протокол:
© Цитата:
range: 1:
control output before sort:
59 30 99 28 27 87 65 98 25 29 92 88 73 84 81 41
59 30 99 28 27 87 65 98
25 29 92 88 73 84 81 41
control output after sort:
25 59 29 30 92 99 28 88 27 73 84 87 65 81 41 98
range: 2:
control output before sort:
25 59 29 30 92 99 28 88 27 73 84 87 65 81 41 98
25 59 29 30 92 99 28 88
27 73 84 87 65 81 41 98
control output after sort:
25 27 59 73 29 30 84 87 65 81 92 99 28 41 88 98
range: 4:
control output before sort:
25 27 59 73 29 30 84 87 65 81 92 99 28 41 88 98
25 27 59 73 29 30 84 87
65 81 92 99 28 41 88 98
control output after sort:
25 27 59 65 73 81 92 99 28 29 30 41 84 87 88 98
range: 8:
control output before so rt:
25 27 59 65 73 81 92 99 28 29 30 41 84 87 88 98
25 27 59 65 73 81 92 99
28 29 30 41 84 87 88 98
control output after sort:
25 27 28 29 30 41 59 65 73 81 84 87 88 92 98 99

Удачи!

Консультировал: Зенченко Константин Николаевич (Старший модератор)
Дата отправки: 01.10.2019, 16:06
Рейтинг ответа:

НЕ одобряю +1 одобряю!

Консультация # 196467:

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

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

pascal

Дата отправки: 27.09.2019, 10:05
Вопрос задал: rail (Посетитель)
Всего ответов: 1
Страница онлайн-консультации »

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

Здравствуйте, 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 одобряю!

Оценить выпуск | Задать вопрос экспертам

главная страница  |  стать участником  |  получить консультацию
техническая поддержка

Дорогой читатель!
Команда портала RFPRO.RU благодарит Вас за то, что Вы пользуетесь нашими услугами. Вы только что прочли очередной выпуск рассылки. Мы старались. Пожалуйста, оцените его. Если совет помог Вам, если Вам понравился ответ, Вы можете поблагодарить автора - для этого в каждом ответе есть специальные ссылки. Вы можете оставить отзыв о работе портале. Нам очень важно знать Ваше мнение. Вы можете поближе познакомиться с жизнью портала, посетив наш форум, почитав журнал, который издают наши эксперты. Если у Вас есть желание помочь людям, поделиться своими знаниями, Вы можете зарегистрироваться экспертом. Заходите - у нас интересно!
МЫ РАБОТАЕМ ДЛЯ ВАС!
В избранное