IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Линейная вставка, Задача
сообщение
Сообщение #1


Гость






Пожалуйста, помогите!!!!
Без понятия как сделать, а уже скоро сдавать wacko.gif

Линейная вставка

1. демонстрационный пошаговй режим сортировки;
Демонстрационный режим должен выдавать на экран информацию о текущем состоянии массива на каждом шаге: сравниваемые элементы выделять зеленым цветом, если они не являются инверсией и красным, если это инверсия. Результат перестаноки должен быть виден на следующей строке. Справа показано текущее количество сравнений и перестановок. Сравнить полученные ре-зультаты с оценками алгоритма.
Подготовить входные тестовые данные для демонстационного режима в виде констант-массивов размером n=10:
a) упорядоченный массив (нет инверсий);
b) максимально неупорядоченный массив: максимальное количество инверсий, рав-ное n(n-1);
c) пустой массив (n = 0);
d) массив со средней упорядоченностью: среднее количество инверсий, равное n(n-1)/2.


2. исследовательский режим сортировки.
Исследовательский режим сортировки должен быть выполнен для следующих размеров тестовых массивов и расчет производить по результатам 100 испытаний для сгенерированных целочислен-ных массивов (упорядоченных, среднее число инверсий, максимальное число инверсий):

Структура интерфейса исследовательского режима. Исходные данные можно задавать в виде констант. Вывод результатов - непрерывный - до окончания или прерывания по ESC. Полученные данные занести в таблицу.
Метод: ХХХХХХХХ ХХХХХХХХ.
Кол.элементов = 256 Кол.повторний = 100 Диапазон = 1000
Исходный порядок - Отсортированный(случайный, обратный)
Перемешивание = 128 (обмен местами упорядоченных пар = 2)
Мин. Средн. Макс.
Сравнений = ХХХХ ХХХХ ХХХХ
Перестановок = ХХХХ ХХХХ ХХХХ
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Гость






Я тут немного переделал, вроде должно работать, но ??? выдает какието числа???
может кто поможет?

Исходный код
uses crt;

Procedure GetUserInput;
Const
kbEsc = #27;
kbSpace = #32;
Var
ch: Char;
Begin
Repeat
ch := ReadKey;
If ch = kbEsc then
begin
GotoXY(1, 24);
WriteLn('breaking program');
Halt(100)
end;

While KeyPressed Do ReadKey
Until ch = kbSpace
End;


Const n = 10;
{ a: Array[1 .. n] Of Integer = (44, 55, 12, 42, 94, 18, 6, 67, 38, 78);}
b: Array[1 .. n] of Integer = (0, 1, 2, 3, 4, 5, 6, 7, 8, 9);
c: Array[1 .. n] Of Integer = (9, 8, 7, 6, 5, 4, 3, 2, 1, 0);
d: Array[1 .. n] Of Integer = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
e: Array[1 .. n] Of Integer = (44, 55, 12, 42, 94, 18, 6, 67, 38, 78);
var a: array[1 .. n] of integer;

Procedure sel;
var sel :char;
temp : integer;
{a: array[1 .. n] of integer;}
begin
sel := readkey;
if sel= '1' then begin for temp:=1 to 10 do a[temp]:=b[temp];end;
if sel= '2' then begin for temp:=1 to 10 do a[temp]:=c[temp];end;
if sel= '3' then begin for temp:=1 to 10 do a[temp]:=d[temp];end;
if sel= '4' then begin for temp:=1 to 10 do a[temp]:=e[temp];end;

end;

Type
Index = 0..n;

Procedure PrintArray(Const s: String);
Var i: Index;
Begin
TextColor(LightGray);
For i := 1 To n Do
Write(a[i]:4);
{WriteLn(s:25);}
GetUserInput
End;


(*
Global variables
*)
Var
x: integer;
cnt_comp, cnt_swap: integer;
ToDo: boolean;

Type
TOperation =
(opSelect, opCompare, opMove);
Const
strAction: array[TOperation] of string =
( 'current selection',
'comparison',
'moving' );

Type
TMask =
(mskHidden, mskNormal, mskRed, mskGreen);
Const
OutputColor: Array[TMask] Of Integer =
(Black, LightGray, LightRed, LightGreen);

Var
show_mask:
Array[1 .. 2, 1 .. n] Of TMask;
show_values:
Array[1 .. 2, 1 .. n] Of Integer;


Procedure ShowByMask(Const s: String;
ival: Integer);

Procedure Scroll(x: Byte);
Var
i: Byte;
Begin
For i := 1 To x Do
WriteLn
End;

Const
scrollBy = 4;
Var
PosY: Integer;
m, k: Index;
Begin
PosY := WhereY;
If PosY > 22 Then
Begin
Scroll(scrollBy);
Dec(PosY, scrollBy - 2);
GotoXY(1, PosY);
End;

Writeln('i = ', ival);
PosY := WhereY;

For m := 1 to 2 do
For k := 1 to n do
Begin
GotoXY(Pred(k)*4 + 1, Pred(PosY + m));
TextColor( OutputColor[show_mask[m, k]] );
Write(show_values[m, k]:4)
End;

TextColor(LightGray);
Gotoxy(n*4 + 1, Pred(WhereY)); Write(s:25);
GotoXY(79, Succ(WhereY));
WriteLn;

GetUserInput
End;

Procedure ShowStep(op: TOperation;
i, j: Integer);
Var
m, k: Index;
Begin
Case op of
opSelect:
For k := 1 To n Do
Begin
If k = i Then
Begin
show_mask[1, k] := mskHidden;
show_mask[2, k] := mskNormal
End
Else
Begin
show_mask[1, k] := mskNormal;
show_mask[2, k] := mskHidden
End;

show_values[1, k] := a[k];
show_values[2, k] := a[k]
End;

opCompare:
Begin
Inc(cnt_comp);

For k := 1 to n do
Begin
If i = k then
If x < a[j] Then show_mask[2, k] := mskRed
Else show_mask[2, k] := mskGreen;

If j = k Then
If x < a[j] Then show_mask[1, k] := mskRed
Else show_mask[1, k] := mskGreen;

show_values[1, k] := a[k];
show_values[2, k] := a[k]
End;

For k := 1 To n Do
If k <> i Then show_mask[2, k] := mskHidden;

show_mask[1, Succ(j)] := mskHidden;
show_values[2, i] := x;
End;

opMove:
Begin
Inc(cnt_swap);
For k := 1 to n do
Begin
show_mask[1, k] := mskNormal;
show_mask[2, k] := mskHidden;

show_values[1, k] := a[k];
End;

show_mask[1, Succ(j)] := mskHidden;
show_mask[2, i] := mskNormal;
show_values[2, i] := x;
End
End;

ShowByMask(strAction[op], i)
End;


Function isLess(index_i, index_j,
i, j: Integer): Boolean;
Begin
isLess := (i < j);

If ToDo Then
ShowStep( opSelect, index_i, index_j );
If index_j > 0 Then
ShowStep( opCompare, index_i, index_j )
End;


(*
main sorting procedure ...
*)
Procedure Insert;
Var
i, j : Index;
Begin
cnt_comp := 0; cnt_swap := 0;
For i := 1 To n do
Begin
x := a[i];

ToDo := True;
j := Pred(i);
While isLess(i, j, x, a[j]) Do
Begin
ToDo := False;
a[Succ(j)] := a[j]; Dec(j);
ShowStep(opMove, i, j)
End;
a[Succ(j)] := x;

(*
j:= i-1;
while x < a[j] do
begin
a[j+1]:= a[j]; j:= j-1;
end;
a[j+1]:= x;
*)

WriteLn( 'i = ', i );
PrintArray('insertion')

End;
End;


Begin
{ ClrScr;}
writeln ('выбор массива');
writeln ('1 упорядоченный массив');
writeln ('2 максимально неупорядоченный массив');
writeln ('3 пустой массив');
writeln ('4 массив со средней упорядоченностью');

sel;

PrintArray( 'Initial array' );


Insert;

WriteLn( 'Total comparisons: ', cnt_comp );
WriteLn( 'Total movings: ', cnt_swap );

ReadLn
End.
 К началу страницы 
+ Ответить 

Сообщений в этой теме
Nikolay   Линейная вставка   30.11.2005 3:10
volvo   Делал когда-то (только демонстрационный режим):   30.11.2005 3:22
Nikolay   Я тут немного переделал, вроде должно работать, но…   1.12.2005 3:36
volvo   Nikolay, а что собственно не устраивает? Я провери…   1.12.2005 3:45
best place to buy viagra online   Amitriptyline Online Uk   1.11.2021 21:38
Nikolay   если повторение то не читать 0 1 2 3 4 5 6…   1.12.2005 4:01
volvo   Не знаю, откуда они у тебя берутся. Вот как это же…   1.12.2005 4:03
Nikolay   какойбы не выберал, всё равно какието странные циф…   1.12.2005 4:13
Nikolay   незнаю как скрин кидать7   1.12.2005 4:14
volvo   Кнопка "Ответить" -> выбираешь файл..…   1.12.2005 4:15
Nikolay   А может быть глюк в версиях Паскаля???   1.12.2005 4:26
volvo   Ну, тогда скажи какой версией пользуешься? У меня …   1.12.2005 4:28
Nikolay   у меня TP7.1 Добавлено (через 5 минут): exe можеш…   1.12.2005 4:36
volvo   Держи EXE от FPC, но у меня нет кириллицы, так что…   1.12.2005 4:52
Nikolay   как с программой так и с кирилицей всё в порядке, …   1.12.2005 5:03
nikolay   СПАСИБО   1.12.2005 5:04


 Ответить  Открыть новую тему 
2 чел. читают эту тему (гостей: 2, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 7.09.2025 15:42
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name