|
Вопрос # 4 710/ вопрос открыт / |
|
Здравствуйте!
Помогите пожалуйтса с написанием программы задание которого звучит следующим образом: "Упорядочить часть линейного массива между максимальным и минимальным элементом в порядке возрастания"
 |
Вопрос задал: Erzhan_Zhanashovich (статус: Посетитель)
Вопрос отправлен: 8 ноября 2010, 12:29
Состояние вопроса: открыт, ответов: 1.
|
Ответ #1. Отвечает эксперт: min@y™
Только в качестве зарядки для мозгов делал:
program p4710;
{$APPTYPE CONSOLE}
const
N = 20;
type
TMyArray = array[0..N - 1] of Integer;
// Заполнение массива случайными числами.
procedure RandomArray(var X: TMyArray);
var
Index: Integer;
begin
for Index:= 0 to N - 1 do
X[Index]:= Random(100);
end;
// Вывод массива на экран.
procedure OutArray(const X: TMyArray);
var
Index: Integer;
begin
Write(' ');
for Index:= 0 to N - 1 do
Write(X[Index]: 3);
WriteLn(#13#10);
end;
// Поиск минимального и максимального элементов массива.
// Функция возвращает True, если между этими индексами не менее 2 элементов.
function FindMinMax(const X: TMyArray; var MinIndex, MaxIndex: Integer): Boolean;
var
Index, Min, Max: Integer;
begin
MinIndex:= 0;
MaxIndex:= 0;
Min:= X[0];
Max:= X[0];
for Index:= 1 to N - 1 do
begin
if X[Index] < Min
then begin
Min:= X[Index];
MinIndex:= Index;
end;
if X[Index] > Max
then begin
Max:= X[Index];
MaxIndex:= Index;
end;
end;
Result:= Abs(MinIndex - MaxIndex) > 2;
end;
// Перестановка двух элементов массива
procedure Exchange(var X: TMyArray; const Index1, Index2: Integer);
var
Temp: Integer;
begin
Temp:= X[Index1];
X[Index1]:= X[Index2];
X[Index2]:= Temp;
end;
// Сортировка массива по возрастанию начиная с элемента номер AFrom и до ATo.
procedure SortArray(var X: TMyArray; const AFrom, ATo: Integer);
var
Index, j, Min, MinIndex: Integer;
begin
for Index:= AFrom + 1 to ATo - 1 do
begin
MinIndex:= Index;
Min:= X[Index];
// Поиск минимального элемента среди элементов Index... ATo - 1
for j:= Index + 1 to ATo - 1 do
if X[j] < Min
then begin
MinIndex:= j;
Min:= X[j];
end;
// Перестановка
if MinIndex <> Index
then Exchange(X, MinIndex, Index);
end;
end;
var
X: TMyArray;
MinIndex, MaxIndex, AFrom, ATo, Total: Integer;
Reason: Boolean;
begin
Randomize();
RandomArray(X);
OutArray(X);
Reason:= FindMinMax(X, MinIndex, MaxIndex);
WriteLn(' Min: X[', MinIndex, '] = ', X[MinIndex]);
WriteLn(' Max: X[', MaxIndex, '] = ', X[MaxIndex]);
if Reason
then begin
if MinIndex < MaxIndex
then begin
AFrom:= MinIndex;
ATo:= MaxIndex;
end
else begin
AFrom:= MaxIndex;
ATo:= MinIndex;
end;
Total:= ATo - AFrom - 1;
SortArray(X, AFrom, ATo);
WriteLn(#13#10' Sorted array between X[', AFrom, '] = ', X[AFrom], ' and X[', ATo, '] = ', X[ATo], ' (Total:
', Total, '):');
OutArray(X);
end
else WriteLn(' Nothing to sorting.');
WriteLn(#13#10' Press ENTER to exit...');
ReadLn;
end.
 |
Ответ отправил: min@y™ (статус: Доктор наук)
Время отправки: 9 ноября 2010, 09:17
Оценка за ответ: 5
Комментарий к оценке: Очень хорошая работа, но еще лучше было бы, если бы она была выполнена в форме....
|
Мини-форум вопроса
Всего сообщений: 8; последнее сообщение — 10 ноября 2010, 11:11; участников в обсуждении: 4.
|
|
min@y™ (статус: Доктор наук), 8 ноября 2010, 12:46 [#1]:
Что не получается? В чём проблема?
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
8 ноября 2010, 12:52: Вопрос перемещён из тематического раздела Delphi » Прочее в раздел Лабораторный практикум » Delphi модератором Ерёмин А.А.
|
|
Erzhan_Zhanashovich (статус: Посетитель), 8 ноября 2010, 18:57 [#2]:
Короче, найти минимум и максимум получилось, а сортировку я не умею.... И если вас не затруднит, не могли бы вы написать программу полностью...
|
|
Егор (статус: 10-ый класс), 8 ноября 2010, 21:13 [#3]:
смотрим сюда
Опасайтесь багов в приведенном выше коде; я только доказал корректность, но не запускал его.
— Donald E. Knuth.
|
|
6ruse (статус: 1-ый класс), 9 ноября 2010, 05:51 [#4]:
procedure Sorting(Down: boolean; var Data: Variant);
var
Skach, m, n: integer;
St: boolean;
Tmp: Variant;
begin
Skach := VarArrayHighBound(Data, 1) - 1;
while Skach > 0 do
begin
Skach := Skach div 2;
repeat
St := True;
for m := 0 to VarArrayHighBound(Data, 1) - 1 - Skach do
begin
n := m + Skach;
if (Down and (Data[n] < Data[m]))
or ((not Down) and (Data[n] > Data[m])) then
begin
Tmp := Data[m];
Data[m] := Data[n];
Data[n] := Tmp;
St := False;
end;
end;
until St;
end;
end;
// пример использования
procedure TForm1.SortingClick(Sender: TObject);
var
A: Variant;
i: integer;
begin
A := VarArrayCreate([0, Memo1.Lines.Count - 1], varVariant);
for i := 0 to Memo1.Lines.Count - 1 do
A[i] := Memo1.Lines.Strings[i];
Sorting(True, A);
for i := 0 to Memo1.Lines.Count - 1 do
Memo1.Lines.Strings[i] := A[i];
end;
|
|
|
min@y™ (статус: Доктор наук), 9 ноября 2010, 13:07 [#5]:
Сделал из консольного приложение с формой.
Качай отсюдова и проверяй.
З.Ы. Где моя оценка за ответ?
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
min@y™ (статус: Доктор наук), 10 ноября 2010, 10:59 [#6]:
Цитата (Erzhan_Zhanashovich):
Комментарий к оценке: Очень хорошая работа, но еще лучше было бы, если бы она была выполнена в форме....
Так я уже сделал в форме. И залил в инет, и ссылку дал.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
Erzhan_Zhanashovich (статус: Посетитель), 10 ноября 2010, 11:07 [#7]:
В том-то и дело, что ссылка окрывается пустой....
Может ты мне просто на почту скинешь ее...) damansc@mail.ru
|
|
|
min@y™ (статус: Доктор наук), 10 ноября 2010, 11:11 [#8]:
Цитата (Erzhan_Zhanashovich):
В том-то и дело, что ссылка окрывается пустой....
Неправда! Щас попробовал - всё качается!
А ты каким браузером пользуешься?
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
|
