| ← Апрель 2020 → | ||||||
|
1
|
2
|
3
|
4
|
5
|
||
|---|---|---|---|---|---|---|
|
6
|
7
|
8
|
9
|
10
|
11
|
12
|
|
13
|
16
|
17
|
18
|
|||
|
21
|
22
|
23
|
24
|
|||
|
30
|
||||||
За последние 60 дней ни разу не выходила
Сайт рассылки:
http://rusfaq.ru/
Открыта:
14-03-2002
Статистика
0 за неделю
RFpro.ru: Программирование на Delphi и Lazarus
| РАССЫЛКИ ПОРТАЛА RFPRO.RU
Лучшие эксперты в разделе
∙ Pascal / Delphi / Lazarus
Код :: выделить код const L2 = 8 Здравствуйте, помогите пожалуйста исправить ошибку в программе. Нужно отсортировать по алфавиту слова с помощью поразрядной сортировки. Код :: выделить код
const
L2 = 8;
type
Mas12 = array [1..L2] of string;
STR = ^STRElement;
STRElement = record
data: string;//Значение элемента
raz: string; //Номер разряда
right, down: STR;
end;
procedure RadixSortString(var Mas: Mas12);//Поразрядная сортировка строк
procedure Obhod1(var Mas: Mas12; a, b, s, e, k: integer);
//Проход по разряду №b с a наборов значений, от s до e в массиве с макс. разрядом = k
begin
//Фаза 1: создание списка разрядов
var Head, Act, Prev: STR;
for var r := 'а' to 'я' do //Задать список из разрядов
begin
new(Act); //Новый элемент списка
if r = 'а' then //Если разряд первый
begin
Head := Act; //Начало списка - актуал
Prev := Head; //Предыдущий элемент - голова
end
else
begin
Prev^.right := Act; //Предыдущий для следующего - актуал
Prev := Prev^.right; //Сдвиг предыдущего на актуал
end;
Act^.raz := r; //Разряд актуала - актуальный разряд
Act := Act^.right; //Сдвиг актуала вправо
end;
//Фаза 2: заполнение списка разрядов
for var j := s to e do //Обход каждого элемента
begin
var ZnachRaz := Mas[j]; //Запомнить актуальный элемент
//Отсеивание лишних разрядов с правой части числа
ZnachRaz := copy(ZnachRaz, b, 1);
Act := Head; //Вернуть актуал в начало списка
var temp := Head;
for var r := 'а' to 'я' do //Занесение элемента в один из разрядов
begin
if r = ZnachRaz.ToLower then //Если разряд совпадает со значением разряда элемента
begin
while Act <> nil do //Добавить его в нижнюю часть списка
begin
Prev := Act; //Предыдущий просмотренный - текущий актуал
Act := Act^.down; //Сдвиг актуала вниз
end; //Когда найден конец списка
new(Act); //Новый элемент
Prev^.down := Act; //Для предыдущего следующий - актуал
Act^.data := Mas[j]; //Его значение - значение элемента
break; //Прервать поиск разрядов для элемента
end
else Act := Act^.right; //Разряд не тот? Проверять дальше
Temp := Temp^.right;
Act := Temp;
end;
end;
Act := Head;
//Фаза 3: перенос списка разрядов в массив
var j := s; //Счётчик элементов
Act := Head; //Переместить актуал в начало
for var z := 'а' to 'я' do //Пройти по всем подспискам
begin
Prev := Act; //Запомнить начало столбца разрядов
if Act^.down <> nil then println(Act^.raz, '--------------------------------------------------------');
Act := Act^.down;
if Act <> nil then while Act <> nil do //Пройти столбец целиком
begin
println('Элемент №', j, Act^.data); //Тестовый вывод
Mas[j] := Act^.data; //Значение массива - значение из столбца
inc(j); //Увеличить индексный счётчик массива
Act := Act^.down;
end;
Act := Prev^.right; //Перейти на правый разряд
end;
//Фаза 4: рекурсия
e := s; inc(b);
while e <> L2 do //Пока не будет пройдено всё количество реальных значений разряда
begin
//Шаг 1) Выделить подмассив из одинаковых значений разряда
while (s < L2) and (Mas[s][b] = ' ') do inc(s);
var TMP := Mas[s][b];
e := s; //Конец подмассива нужно найти, то есть это поиск с начала массива
while (e < L2) and (Mas[e + 1][b] = TMP) do inc(e);
//Шаг 2) Использовать подмассив как массив и обойти его (если b<=k)
if (b < k) and (s < e) then Obhod1(Mas, 33, b, s, e, k);
s := e + 1; //Если подмассив пройден, то началом будет конец
end;
end;{Конец процедуры обхода}
begin
var k := 0; //Счётчик разрядов
for var i := 1 to L2 do //Поиск максимального разряда в массиве
begin
var temp1 := Mas[i];
var temp2 := 0;
while temp1.Length <> 0 do
begin
temp1 := copy(temp1, 1, temp1.Length - 1);
inc(temp2);
end;
if temp2 > k then k := temp2;
end;
for var i := 1 to L2 do
while Mas[i].Length < k do Mas[i] += ' ';
{Начало сортировки}
Obhod1(Mas, 33, 1, 1, L2, k);
for var i := 1 to L2 do
for var j := Mas[i].Length downto 1 do
if Mas[i][j] = ' ' then delete(Mas[i], j, 1)
else break;
end;
begin
writeln('Сортировка строк распределением');
write('Изначальный массив: ');
var Massiv: Mas12 := ('неделя','око','илья','окно','невод','ил','игла','вилы');
writeln(Massiv);
RadixSortString(Massiv);
writeln(chr(13), 'Сортировка завершена!');
write('Отсортированный массив: ');
writeln(Massiv);
end.
Дата отправки: 19.04.2020, 17:38 Консультирует Зенченко Константин Николаевич (Старший модератор): Здравствуйте, Be|_Ena! Код (Pascal) :: выделить код const
n=8;
type
tMas=array[1..n]of string;
procedure radix(var ra:tMas;b:integer);
begin
if b>0 then
begin
var c:integer=1;
repeat
if ra[c][b]>ra[c+1][b]then
begin
var d:string=ra[c];
ra[c]:=ra[c+1];
ra[c+1]:=d;
c:=1;
end else inc(c);
//контрольный вывод внутри подпрограммы
// writeln(ra);
until c=n;
radix(ra,b-1);
end;
end;
begin
var a:tMas=('неделя','око','илья','окно','невод','ил','игла','вилы');
var c:integer = 0;
writeln(a);//выводим исходный массив
for var b:=1 to n do if length(a[b])>c then c:=length(a[b]);//считаем максимальную длину
for var b:=1 to n do while length(a[b])<c do a[b]:=a[b]+' ';//выравниваем разряды
writeln(a);//контрольный вывод до сортировки
radix(a,c);
writeln(a);//контрольный вывод после сортировки
for var b:=1 to n do while a[b][length(a[b])]=' 'do delete(a[b],length(a[b]),1);//удаляем выравненые разряды
writeln(a);//вывод результата
end.Удачи!
Оценить выпуск | Задать вопрос экспертам
главная страница
|
стать участником
|
получить консультацию
|
| В избранное | ||
